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