1# Net::Domain.pm 2# 3# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved. 4# This program is free software; you can redistribute it and/or 5# modify it under the same terms as Perl itself. 6 7package Net::Domain; 8 9require Exporter; 10 11use Carp; 12use strict; 13use vars qw($VERSION @ISA @EXPORT_OK); 14use Net::Config; 15 16@ISA = qw(Exporter); 17@EXPORT_OK = qw(hostname hostdomain hostfqdn domainname); 18 19$VERSION = "2.19"; # $Id: //depot/libnet/Net/Domain.pm#21 $ 20 21my($host,$domain,$fqdn) = (undef,undef,undef); 22 23# Try every conceivable way to get hostname. 24 25sub _hostname { 26 27 # we already know it 28 return $host 29 if(defined $host); 30 31 if ($^O eq 'MSWin32') { 32 require Socket; 33 my ($name,$alias,$type,$len,@addr) = gethostbyname($ENV{'COMPUTERNAME'}||'localhost'); 34 while (@addr) 35 { 36 my $a = shift(@addr); 37 $host = gethostbyaddr($a,Socket::AF_INET()); 38 last if defined $host; 39 } 40 if (defined($host) && index($host,'.') > 0) { 41 $fqdn = $host; 42 ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/; 43 } 44 return $host; 45 } 46 elsif ($^O eq 'MacOS') { 47 chomp ($host = `hostname`); 48 } 49 elsif ($^O eq 'VMS') { ## multiple varieties of net s/w makes this hard 50 $host = $ENV{'UCX$INET_HOST'} if defined($ENV{'UCX$INET_HOST'}); 51 $host = $ENV{'MULTINET_HOST_NAME'} if defined($ENV{'MULTINET_HOST_NAME'}); 52 if (index($host,'.') > 0) { 53 $fqdn = $host; 54 ($host,$domain) = $fqdn =~ /^([^\.]+)\.(.*)$/; 55 } 56 return $host; 57 } 58 else { 59 local $SIG{'__DIE__'}; 60 61 # syscall is preferred since it avoids tainting problems 62 eval { 63 my $tmp = "\0" x 256; ## preload scalar 64 eval { 65 package main; 66 require "syscall.ph"; 67 defined(&main::SYS_gethostname); 68 } 69 || eval { 70 package main; 71 require "sys/syscall.ph"; 72 defined(&main::SYS_gethostname); 73 } 74 and $host = (syscall(&main::SYS_gethostname, $tmp, 256) == 0) 75 ? $tmp 76 : undef; 77 } 78 79 # POSIX 80 || eval { 81 require POSIX; 82 $host = (POSIX::uname())[1]; 83 } 84 85 # trusty old hostname command 86 || eval { 87 chop($host = `(hostname) 2>/dev/null`); # BSD'ish 88 } 89 90 # sysV/POSIX uname command (may truncate) 91 || eval { 92 chop($host = `uname -n 2>/dev/null`); ## SYSV'ish && POSIX'ish 93 } 94 95 # Apollo pre-SR10 96 || eval { 97 $host = (split(/[:\. ]/,`/com/host`,6))[0]; 98 } 99 100 || eval { 101 $host = ""; 102 }; 103 } 104 105 # remove garbage 106 $host =~ s/[\0\r\n]+//go; 107 $host =~ s/(\A\.+|\.+\Z)//go; 108 $host =~ s/\.\.+/\./go; 109 110 $host; 111} 112 113sub _hostdomain { 114 115 # we already know it 116 return $domain 117 if(defined $domain); 118 119 local $SIG{'__DIE__'}; 120 121 return $domain = $NetConfig{'inet_domain'} 122 if defined $NetConfig{'inet_domain'}; 123 124 # try looking in /etc/resolv.conf 125 # putting this here and assuming that it is correct, eliminates 126 # calls to gethostbyname, and therefore DNS lookups. This helps 127 # those on dialup systems. 128 129 local *RES; 130 local($_); 131 132 if(open(RES,"/etc/resolv.conf")) { 133 while(<RES>) { 134 $domain = $1 135 if(/\A\s*(?:domain|search)\s+(\S+)/); 136 } 137 close(RES); 138 139 return $domain 140 if(defined $domain); 141 } 142 143 # just try hostname and system calls 144 145 my $host = _hostname(); 146 my(@hosts); 147 148 @hosts = ($host,"localhost"); 149 150 unless (defined($host) && $host =~ /\./) { 151 my $dom = undef; 152 eval { 153 my $tmp = "\0" x 256; ## preload scalar 154 eval { 155 package main; 156 require "syscall.ph"; 157 } 158 || eval { 159 package main; 160 require "sys/syscall.ph"; 161 } 162 and $dom = (syscall(&main::SYS_getdomainname, $tmp, 256) == 0) 163 ? $tmp 164 : undef; 165 }; 166 167 if ( $^O eq 'VMS' ) { 168 $dom ||= $ENV{'TCPIP$INET_DOMAIN'} 169 || $ENV{'UCX$INET_DOMAIN'}; 170 } 171 172 chop($dom = `domainname 2>/dev/null`) 173 unless(defined $dom || $^O =~ /^(?:cygwin|MSWin32)/); 174 175 if(defined $dom) { 176 my @h = (); 177 $dom =~ s/^\.+//; 178 while(length($dom)) { 179 push(@h, "$host.$dom"); 180 $dom =~ s/^[^.]+.+// or last; 181 } 182 unshift(@hosts,@h); 183 } 184 } 185 186 # Attempt to locate FQDN 187 188 foreach (grep {defined $_} @hosts) { 189 my @info = gethostbyname($_); 190 191 next unless @info; 192 193 # look at real name & aliases 194 my $site; 195 foreach $site ($info[0], split(/ /,$info[1])) { 196 if(rindex($site,".") > 0) { 197 198 # Extract domain from FQDN 199 200 ($domain = $site) =~ s/\A[^\.]+\.//; 201 return $domain; 202 } 203 } 204 } 205 206 # Look for environment variable 207 208 $domain ||= $ENV{LOCALDOMAIN} || $ENV{DOMAIN}; 209 210 if(defined $domain) { 211 $domain =~ s/[\r\n\0]+//g; 212 $domain =~ s/(\A\.+|\.+\Z)//g; 213 $domain =~ s/\.\.+/\./g; 214 } 215 216 $domain; 217} 218 219sub domainname { 220 221 return $fqdn 222 if(defined $fqdn); 223 224 _hostname(); 225 _hostdomain(); 226 227 # Assumption: If the host name does not contain a period 228 # and the domain name does, then assume that they are correct 229 # this helps to eliminate calls to gethostbyname, and therefore 230 # eleminate DNS lookups 231 232 return $fqdn = $host . "." . $domain 233 if(defined $host and defined $domain 234 and $host !~ /\./ and $domain =~ /\./); 235 236 # For hosts that have no name, just an IP address 237 return $fqdn = $host if defined $host and $host =~ /^\d+(\.\d+){3}$/; 238 239 my @host = defined $host ? split(/\./, $host) : ('localhost'); 240 my @domain = defined $domain ? split(/\./, $domain) : (); 241 my @fqdn = (); 242 243 # Determine from @host & @domain the FQDN 244 245 my @d = @domain; 246 247LOOP: 248 while(1) { 249 my @h = @host; 250 while(@h) { 251 my $tmp = join(".",@h,@d); 252 if((gethostbyname($tmp))[0]) { 253 @fqdn = (@h,@d); 254 $fqdn = $tmp; 255 last LOOP; 256 } 257 pop @h; 258 } 259 last unless shift @d; 260 } 261 262 if(@fqdn) { 263 $host = shift @fqdn; 264 until((gethostbyname($host))[0]) { 265 $host .= "." . shift @fqdn; 266 } 267 $domain = join(".", @fqdn); 268 } 269 else { 270 undef $host; 271 undef $domain; 272 undef $fqdn; 273 } 274 275 $fqdn; 276} 277 278sub hostfqdn { domainname() } 279 280sub hostname { 281 domainname() 282 unless(defined $host); 283 return $host; 284} 285 286sub hostdomain { 287 domainname() 288 unless(defined $domain); 289 return $domain; 290} 291 2921; # Keep require happy 293 294__END__ 295 296=head1 NAME 297 298Net::Domain - Attempt to evaluate the current host's internet name and domain 299 300=head1 SYNOPSIS 301 302 use Net::Domain qw(hostname hostfqdn hostdomain); 303 304=head1 DESCRIPTION 305 306Using various methods B<attempt> to find the Fully Qualified Domain Name (FQDN) 307of the current host. From this determine the host-name and the host-domain. 308 309Each of the functions will return I<undef> if the FQDN cannot be determined. 310 311=over 4 312 313=item hostfqdn () 314 315Identify and return the FQDN of the current host. 316 317=item hostname () 318 319Returns the smallest part of the FQDN which can be used to identify the host. 320 321=item hostdomain () 322 323Returns the remainder of the FQDN after the I<hostname> has been removed. 324 325=back 326 327=head1 AUTHOR 328 329Graham Barr <gbarr@pobox.com>. 330Adapted from Sys::Hostname by David Sundstrom <sunds@asictest.sc.ti.com> 331 332=head1 COPYRIGHT 333 334Copyright (c) 1995-1998 Graham Barr. All rights reserved. 335This program is free software; you can redistribute it and/or modify 336it under the same terms as Perl itself. 337 338=for html <hr> 339 340I<$Id: //depot/libnet/Net/Domain.pm#21 $> 341 342=cut 343