]> git.ipfire.org Git - thirdparty/gcc.git/blame - libgfortran/intrinsics/getlog.c
Update copyright years in libgfortran.
[thirdparty/gcc.git] / libgfortran / intrinsics / getlog.c
CommitLineData
f77b6ca3 1/* Implementation of the GETLOG g77 intrinsic.
e3c063ce 2 Copyright (C) 2005-2013 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
53390685 28#include <stdlib.h>
deeab820 29#include <string.h>
36ae8a61 30
f77b6ca3 31#ifdef HAVE_UNISTD_H
aa4042b1
TB
32# if defined __MINGW32__ && defined HAVE_GETLOGIN
33# define _POSIX 1
34# endif
f77b6ca3
FXC
35#include <unistd.h>
36#endif
6422c112
FXC
37#ifdef HAVE_PWD_H
38#include <pwd.h>
39#endif
f77b6ca3 40
86ab6320
FXC
41/* Windows32 version */
42#if defined __MINGW32__ && !defined HAVE_GETLOGIN
43#define WIN32_LEAN_AND_MEAN
44#include <windows.h>
45#include <lmcons.h> /* for UNLEN */
46
47static char *
48w32_getlogin (void)
49{
50 static char name [UNLEN + 1];
51 DWORD namelen = sizeof (name);
52
53 GetUserName (name, &namelen);
54 return (name[0] == 0 ? NULL : name);
55}
56
57#undef getlogin
58#define getlogin w32_getlogin
59#define HAVE_GETLOGIN 1
60
61#endif
62
63
f77b6ca3
FXC
64/* GETLOG (LOGIN), g77 intrinsic for retrieving the login name for the
65 process.
66 CHARACTER(len=*), INTENT(OUT) :: LOGIN */
67
f77b6ca3
FXC
68void PREFIX(getlog) (char *, gfc_charlen_type);
69export_proto_np(PREFIX(getlog));
70
deeab820 71void
f77b6ca3
FXC
72PREFIX(getlog) (char * login, gfc_charlen_type login_len)
73{
74 int p_len;
75 char *p;
76
77 memset (login, ' ', login_len); /* Blank the string. */
78
23e6d4a5 79#if defined(HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID)
15fb94ae
JB
80 struct passwd pwd;
81 struct passwd *result;
82 char *buf;
83 int err;
84 /* To be pedantic, buflen should be determined by
85 sysconf(_SC_GETPW_R_SIZE_MAX), which is 1024 on some tested
86 targets; we do something simple in case the target doesn't
87 support sysconf. */
88 static const size_t buflen = 1024;
1a0fd3d3 89 buf = xmalloc (buflen);
15fb94ae
JB
90 err = getpwuid_r (geteuid (), &pwd, buf, buflen, &result);
91 if (err != 0 || result == NULL)
92 goto cleanup;
93 p = pwd.pw_name;
94#elif defined(HAVE_GETPWUID) && defined(HAVE_GETEUID)
6422c112
FXC
95 {
96 struct passwd *pw = getpwuid (geteuid ());
97 if (pw)
98 p = pw->pw_name;
99 else
100 return;
101 }
15fb94ae 102#elif HAVE_GETLOGIN
6422c112
FXC
103 p = getlogin();
104# else
105 return;
6422c112
FXC
106#endif
107
f77b6ca3 108 if (p == NULL)
15fb94ae 109 goto cleanup;
f77b6ca3
FXC
110
111 p_len = strlen (p);
112 if (login_len < p_len)
15fb94ae
JB
113 p_len = login_len;
114 memcpy (login, p, p_len);
115
116 cleanup:
23e6d4a5 117#if defined (HAVE_POSIX_GETPWUID_R) && defined(HAVE_GETEUID)
15fb94ae 118 free (buf);
8717f52f
KT
119#else
120 ;
15fb94ae 121#endif
f77b6ca3 122}