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