1/* Implementation of the HOSTNM intrinsic.
2   Copyright (C) 2005-2022 Free Software Foundation, Inc.
3   Contributed by Fran��ois-Xavier Coudert <coudert@clipper.ens.fr>
4
5This file is part of the GNU Fortran runtime library (libgfortran).
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
10version 3 of the License, or (at your option) any later version.
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
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/>.  */
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
48static int
49w32_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
88static int
89hostnm_0 (char *name, gfc_charlen_type name_len)
90{
91  char p[HOST_NAME_MAX + 1];
92  int val;
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  {
102    for (gfc_charlen_type i = 0; i < name_len && p[i] != '\0'; i++)
103      name[i] = p[i];
104  }
105
106  return ((val == 0) ? 0 : errno);
107}
108
109extern void hostnm_i4_sub (char *, GFC_INTEGER_4 *, gfc_charlen_type);
110iexport_proto(hostnm_i4_sub);
111
112void
113hostnm_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}
119iexport(hostnm_i4_sub);
120
121extern void hostnm_i8_sub (char *, GFC_INTEGER_8 *, gfc_charlen_type);
122iexport_proto(hostnm_i8_sub);
123
124void
125hostnm_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}
131iexport(hostnm_i8_sub);
132
133extern GFC_INTEGER_4 hostnm (char *, gfc_charlen_type);
134export_proto(hostnm);
135
136GFC_INTEGER_4
137hostnm (char *name, gfc_charlen_type name_len)
138{
139  return hostnm_0 (name, name_len);
140}
141#endif
142