|
111
|
1 /* Implementation of the HOSTNM intrinsic.
|
|
131
|
2 Copyright (C) 2005-2018 Free Software Foundation, Inc.
|
|
111
|
3 Contributed by François-Xavier Coudert <coudert@clipper.ens.fr>
|
|
|
4
|
|
|
5 This file is part of the GNU Fortran runtime library (libgfortran).
|
|
|
6
|
|
|
7 Libgfortran is free software; you can redistribute it and/or
|
|
|
8 modify it under the terms of the GNU General Public
|
|
|
9 License as published by the Free Software Foundation; either
|
|
|
10 version 3 of the License, or (at your option) any later version.
|
|
|
11
|
|
|
12 Libgfortran is distributed in the hope that it will be useful,
|
|
|
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
15 GNU General Public License for more details.
|
|
|
16
|
|
|
17 Under Section 7 of GPL version 3, you are granted additional
|
|
|
18 permissions described in the GCC Runtime Library Exception, version
|
|
|
19 3.1, as published by the Free Software Foundation.
|
|
|
20
|
|
|
21 You should have received a copy of the GNU General Public License and
|
|
|
22 a copy of the GCC Runtime Library Exception along with this program;
|
|
|
23 see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|
|
24 <http://www.gnu.org/licenses/>. */
|
|
|
25
|
|
|
26 #include "libgfortran.h"
|
|
|
27
|
|
|
28 #include <errno.h>
|
|
|
29 #include <string.h>
|
|
|
30
|
|
|
31 #ifdef HAVE_UNISTD_H
|
|
|
32 #include <unistd.h>
|
|
|
33 #endif
|
|
|
34
|
|
|
35 #include <limits.h>
|
|
|
36
|
|
|
37 #ifndef HOST_NAME_MAX
|
|
|
38 #define HOST_NAME_MAX 255
|
|
|
39 #endif
|
|
|
40
|
|
|
41
|
|
|
42 /* Windows32 version */
|
|
|
43 #if defined __MINGW32__ && !defined HAVE_GETHOSTNAME
|
|
|
44 #define WIN32_LEAN_AND_MEAN
|
|
|
45 #include <windows.h>
|
|
|
46 #include <errno.h>
|
|
|
47
|
|
|
48 static int
|
|
|
49 w32_gethostname (char *name, size_t len)
|
|
|
50 {
|
|
|
51 /* We could try the WinSock API gethostname, but that will
|
|
|
52 fail if WSAStartup function has has not been called. We don't
|
|
|
53 really need a name that will be understood by socket API, so avoid
|
|
|
54 unnecessary dependence on WinSock libraries by using
|
|
|
55 GetComputerName instead. */
|
|
|
56
|
|
|
57 /* On Win9x GetComputerName fails if the input size is less
|
|
|
58 than MAX_COMPUTERNAME_LENGTH + 1. */
|
|
|
59 char buffer[MAX_COMPUTERNAME_LENGTH + 1];
|
|
|
60 DWORD size = sizeof (buffer);
|
|
|
61
|
|
|
62 if (!GetComputerName (buffer, &size))
|
|
|
63 return -1;
|
|
|
64
|
|
|
65 if ((size = strlen (buffer) + 1) > len)
|
|
|
66 {
|
|
|
67 errno = EINVAL;
|
|
|
68 /* Truncate as per POSIX spec. We do not NUL-terminate. */
|
|
|
69 size = len;
|
|
|
70 }
|
|
|
71 memcpy (name, buffer, (size_t) size);
|
|
|
72
|
|
|
73 return 0;
|
|
|
74 }
|
|
|
75
|
|
|
76 #undef gethostname
|
|
|
77 #define gethostname w32_gethostname
|
|
|
78 #define HAVE_GETHOSTNAME 1
|
|
|
79
|
|
|
80 #endif
|
|
|
81
|
|
|
82
|
|
|
83 /* SUBROUTINE HOSTNM(NAME, STATUS)
|
|
|
84 CHARACTER(len=*), INTENT(OUT) :: NAME
|
|
|
85 INTEGER, INTENT(OUT), OPTIONAL :: STATUS */
|
|
|
86
|
|
|
87 #ifdef HAVE_GETHOSTNAME
|
|
|
88 static int
|
|
|
89 hostnm_0 (char *name, gfc_charlen_type name_len)
|
|
|
90 {
|
|
|
91 char p[HOST_NAME_MAX + 1];
|
|
131
|
92 int val;
|
|
111
|
93
|
|
|
94 memset (name, ' ', name_len);
|
|
|
95
|
|
|
96 size_t reqlen = sizeof (p) > (size_t) name_len + 1
|
|
|
97 ? (size_t) name_len + 1: sizeof (p);
|
|
|
98 val = gethostname (p, reqlen);
|
|
|
99
|
|
|
100 if (val == 0)
|
|
|
101 {
|
|
131
|
102 for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++)
|
|
111
|
103 name[i] = p[i];
|
|
|
104 }
|
|
|
105
|
|
|
106 return ((val == 0) ? 0 : errno);
|
|
|
107 }
|
|
|
108
|
|
|
109 extern void hostnm_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
|
|
|
110 iexport_proto(hostnm_i4_sub);
|
|
|
111
|
|
|
112 void
|
|
|
113 hostnm_i4_sub (char *name, GFC_INTEGER_4 *status, gfc_charlen_type name_len)
|
|
|
114 {
|
|
|
115 int val = hostnm_0 (name, name_len);
|
|
|
116 if (status != NULL)
|
|
|
117 *status = val;
|
|
|
118 }
|
|
|
119 iexport(hostnm_i4_sub);
|
|
|
120
|
|
|
121 extern void hostnm_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type);
|
|
|
122 iexport_proto(hostnm_i8_sub);
|
|
|
123
|
|
|
124 void
|
|
|
125 hostnm_i8_sub (char *name, GFC_INTEGER_8 *status, gfc_charlen_type name_len)
|
|
|
126 {
|
|
|
127 int val = hostnm_0 (name, name_len);
|
|
|
128 if (status != NULL)
|
|
|
129 *status = val;
|
|
|
130 }
|
|
|
131 iexport(hostnm_i8_sub);
|
|
|
132
|
|
|
133 extern GFC_INTEGER_4 hostnm (char *, gfc_charlen_type);
|
|
|
134 export_proto(hostnm);
|
|
|
135
|
|
|
136 GFC_INTEGER_4
|
|
|
137 hostnm (char *name, gfc_charlen_type name_len)
|
|
|
138 {
|
|
|
139 return hostnm_0 (name, name_len);
|
|
|
140 }
|
|
|
141 #endif
|
