ext/Sys-Hostname/Hostname.xs

   1 #define PERL_NO_GET_CONTEXT
   2
   3 #include "EXTERN.h"
   4 #include "perl.h"
   5 #include "XSUB.h"
   6
   7 #if defined(I_UNISTD) && defined(HAS_GETHOSTNAME)
   8 # include <unistd.h>
   9 #endif
  10
  11 /* a reasonable default */
  12 #ifndef MAXHOSTNAMELEN
  13 #  define MAXHOSTNAMELEN        256
  14 #endif
  15
  16 /* swiped from POSIX.xs */
  17 #if defined(__VMS) && !defined(__POSIX_SOURCE)
  18 #  if ((__VMS_VER >= 70000000) && (__DECC_VER >= 50200000)) || (__CRTL_VER >= 70000000)
  19 #    include <utsname.h>
  20 #  endif
  21 #endif
  22
  23 #ifdef I_SYSUTSNAME
  24 #  include <sys/utsname.h>
  25 #endif
  26
  27 MODULE = Sys::Hostname          PACKAGE = Sys::Hostname
  28
  29 void
  30 ghname()
  31     PREINIT:
  32     IV   retval = -1;
  33     SV  *sv;
  34     PPCODE:
  35     EXTEND(SP, 1);
  36 #ifdef HAS_GETHOSTNAME
  37     {
  38         char tmps[MAXHOSTNAMELEN];
  39         retval = PerlSock_gethostname(tmps, sizeof(tmps));
  40         sv = newSVpv(tmps, 0);
  41     }
  42 #else
  43 #  ifdef HAS_PHOSTNAME
  44     {
  45         PerlIO *io;
  46         char tmps[MAXHOSTNAMELEN];
  47         char   *p = tmps;
  48         char    c;
  49         io = PerlProc_popen(PHOSTNAME, "r");
  50         if (!io)
  51             goto check_out;
  52         while (PerlIO_read(io, &c, sizeof(c)) == 1) {
  53             if (isSPACE(c) || p - tmps >= sizeof(tmps))
  54                 break;
  55             *p++ = c;
  56         }
  57         PerlProc_pclose(io);
  58         retval = 0;
  59         sv = newSVpvn(tmps, p - tmps);
  60     }
  61 #  else
  62 #    ifdef HAS_UNAME
  63     {
  64         struct utsname u;
  65         if (PerlEnv_uname(&u) == -1)
  66             goto check_out;
  67         sv = newSVpv(u.nodename, 0);
  68         retval = 0;
  69     }
  70 #    endif
  71 #  endif
  72 #endif
  73 #ifndef HAS_GETHOSTNAME
  74     check_out:
  75 #endif
  76     if (retval == -1)
  77         XSRETURN_UNDEF;
  78     else
  79         PUSHs(sv_2mortal(sv));