This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Probe for <sys/utsname.h>.
[perl5.git] / ext / Sys / Hostname / Hostname.xs
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_SYS_UTSNAME
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     check_out:
73     if (retval == -1)
74         XSRETURN_UNDEF;
75     else
76         PUSHs(sv_2mortal(sv));