3 # Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
4 # reserved. This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
11 Net::Domain - Attempt to evaluate the current host's internet name and domain
15 use Net::Domain qw(hostname hostfqdn hostdomain);
19 Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN)
20 of the current host. From this determine the host-name and the host-domain.
22 Each of the functions will return I<undef> if the FQDN cannot be determined.
28 Identify and return the FQDN of the current host.
32 Returns the smallest part of the FQDN which can be used to identify the host.
36 Returns the remainder of the FQDN after the I<hostname> has been removed.
42 Graham Barr <bodg@tiuk.ti.com>.
43 Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com>
51 Copyright (c) 1995 Graham Barr. All rights reserved.
52 This library is free software; you can redistribute it and/or
53 modify it under the same terms as Perl itself.
61 use vars qw($VERSION @ISA @EXPORT_OK);
64 @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname);
66 $VERSION = sprintf("%d.%02d", q$Revision: 2.0 $ =~ /(\d+)\.(\d+)/);
68 my($host,$domain,$fqdn) = (undef,undef,undef);
70 # Try every conceivable way to get hostname.
74 # method 1 - we already know it
78 # method 2 - syscall is preferred since it avoids tainting problems
84 my $tmp = "\0" x 65; ## preload scalar
85 $host = (syscall(&main::SYS_gethostname, $tmp, 65) == 0) ? $tmp : undef;
89 # method 3 - trusty old hostname command
91 chop($host = `(hostname) 2>/dev/null`); # BSD'ish
94 # method 4 - sysV/POSIX uname command (may truncate)
96 chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish
100 # method 5 - Apollo pre-SR10
102 $host = (split(/[:\. ]/,`/com/host`,6))[0];
110 $host =~ s/[\0\r\n]+//go;
111 $host =~ s/(\A\.+|\.+\Z)//go;
112 $host =~ s/\.\.+/\./go;
119 # method 1 - we already know it
123 # method 2 - just try hostname and system calls
125 my $host = _hostname();
126 my($dom,$site,@hosts);
129 @hosts = ($host,"localhost");
131 unless($host =~ /\./) {
132 chop($dom = `domainname 2>/dev/null`);
133 unshift(@hosts, "$host.$dom")
134 if (defined $dom && $dom ne "");
137 # Attempt to locate FQDN
140 my @info = gethostbyname($_);
144 # look at real name & aliases
145 foreach $site ($info[0], split(/ /,$info[1])) {
146 if(rindex($site,".") > 0) {
148 # Extract domain from FQDN
150 ($domain = $site) =~ s/\A[^\.]+\.//;
156 # try looking in /etc/resolv.conf
160 if(open(RES,"/etc/resolv.conf")) {
163 if(/\A\s*(?:domain|search)\s+(\S+)/);
171 # Look for environment variable
173 $domain ||= $ENV{DOMAIN} || undef;
175 if(defined $domain) {
176 $domain =~ s/[\r\n\0]+//g;
177 $domain =~ s/(\A\.+|\.+\Z)//g;
178 $domain =~ s/\.\.+/\./g;
192 my @host = split(/\./, $host);
193 my @domain = split(/\./, $domain);
196 # Determine from @host & @domain the FQDN
204 my $tmp = join(".",@h,@d);
205 if((gethostbyname($tmp))[0]) {
212 last unless shift @d;
217 until((gethostbyname($host))[0]) {
218 $host .= "." . shift @fqdn;
220 $domain = join(".", @fqdn);
231 sub hostfqdn { domainname() }
235 unless(defined $host);
241 unless(defined $domain);
245 1; # Keep require happy