xref: /petsc/src/sys/utils/fhost.c (revision 4b80df35a2fcaba0d5ac30ff1861fce0c665259a)

#define PETSC_DESIRE_FEATURE_TEST_MACROS /* for getdomainname() */
/*
      Code for manipulating files.
*/
#include <petscsys.h>
#if defined(PETSC_HAVE_SYS_UTSNAME_H)
  #include <sys/utsname.h>
#endif
#if defined(PETSC_HAVE_WINDOWS_H)
  #include <windows.h>
#endif
#if defined(PETSC_HAVE_SYS_SYSTEMINFO_H)
  #include <sys/systeminfo.h>
#endif
#if defined(PETSC_HAVE_UNISTD_H)
  #include <unistd.h>
#endif
#if defined(PETSC_HAVE_NETDB_H)
  #include <netdb.h>
#endif
#include <errno.h>

/*@C
  PetscGetHostName - Returns the name of the host. This attempts to
  return the entire Internet name. It may not return the same name
  as `MPI_Get_processor_name()`.

  Not Collective

  Input Parameter:
. nlen - length of name

  Output Parameter:
. name - contains host name.  Must be long enough to hold the name
           This is the fully qualified name, including the domain.

  Level: developer

  Fortran Note:
.vb
  character*(128) name
  call PetscGetHostName(name,ierr)
.ve

.seealso: `PetscGetUserName()`, `PetscGetArchType()`
@*/
PetscErrorCode PetscGetHostName(char name[], size_t nlen)
{
  char *domain = NULL;
#if defined(PETSC_HAVE_UNAME) && !defined(PETSC_HAVE_GETCOMPUTERNAME)
  struct utsname utname;
#endif

  PetscFunctionBegin;
#if defined(PETSC_HAVE_GETCOMPUTERNAME)
  {
    size_t nnlen = nlen;

    GetComputerName((LPTSTR)name, (LPDWORD)(&nnlen));
  }
#elif defined(PETSC_HAVE_UNAME)
  // According to IEEE Std 1003.1-1988 ("POSIX.1") and 1003.1-2024, upon successful completion, uname returns
  // a non-negative value. Otherwise, -1 shall be returned and errno set to indicate the error.
  PetscCheck(uname(&utname) != -1, PETSC_COMM_SELF, PETSC_ERR_SYS, "uname() due to \"%s\"", strerror(errno));
  PetscCall(PetscStrncpy(name, utname.nodename, nlen));
#elif defined(PETSC_HAVE_GETHOSTNAME)
  PetscCheck(!gethostname(name, nlen), PETSC_COMM_SELF, PETSC_ERR_SYS, "gethostname() due to \"%s\"", strerror(errno));
#endif
  /* if there was not enough room then system call will not null terminate name */
  name[nlen - 1] = 0;

  /* See if this name includes the domain */
  PetscCall(PetscStrchr(name, '.', &domain));
  if (!domain) {
    size_t l, ll;

    PetscCall(PetscStrlen(name, &l));
    if (l == nlen - 1) PetscFunctionReturn(PETSC_SUCCESS);
    name[l++] = '.';
    name[l]   = 0;
#if defined(PETSC_HAVE_GETDOMAINNAME)
    PetscCheck(!getdomainname(name + l, (int)(nlen - l)), PETSC_COMM_SELF, PETSC_ERR_SYS, "getdomainname() due to \"%s\"", strerror(errno));
#endif
    /* check if domain name is not a dnsdomainname and nuke it */
    PetscCall(PetscStrlen(name, &ll));
    if (ll > 4) {
      const char *suffixes[] = {".edu", ".com", ".net", ".org", ".mil", NULL};
      PetscInt    index;

      PetscCall(PetscStrendswithwhich(name, suffixes, &index));
      if (!suffixes[index]) {
        PetscCall(PetscInfo(NULL, "Rejecting domainname, likely is NIS %s\n", name));
        name[l - 1] = 0;
      }
    }
  }
  PetscFunctionReturn(PETSC_SUCCESS);
}