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