Net-Domain-1.06

7 files changed, 412 insertions, 0 deletions

diff --git a/Net-Domain/Domain.pm b/Net-Domain/Domain.pm
new file mode 100755
index 0000000..e3e0ffb
--- /dev/null
+++ b/Net-Domain/Domain.pm
@@ -0,0 +1,279 @@
+#
+
+package Net::Domain;
+
+use Carp;
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(hostname domainname hostdomain);
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/);
+sub Version { $VERSION }
+
+=head1 NAME
+
+Net::Domain - Attempt to evaluate the current host's internet name and domain
+
+=head1 SYNOPSIS
+
+  use Net::Domain qw(hostname domainname hostdomain);
+
+=head1 DESCRIPTION
+
+Using various methods B<attempt> to find the FQDN of the current host. From
+this find the hostname and the hostdomain.
+
+=cut
+
+$host = undef;
+$domain = undef;
+$fqdn = undef;
+
+#
+# Try every conceivable way to get hostname.
+# 
+
+sub _hostname {
+# by David Sundstrom   sunds@asictest.sc.ti.com
+#    Texas Instruments
+
+ # method 1 - we already know it
+
+ return $host if(defined $host);
+
+ # method 2 - syscall is preferred since it avoids tainting problems
+ eval {
+  {
+   package main;
+   require "syscall.ph";
+  }
+  my $tmp = "\0" x 65; ## preload scalar
+  $host = (syscall(&main::SYS_gethostname, $tmp, 65) == 0) ? $tmp : undef;
+ }
+
+
+ # method 3 - trusty old hostname command
+ || eval {
+  chop($host = `(hostname) 2>/dev/null`); # bsdish
+ }
+
+
+ # method 4 - sysV/POSIX uname command (may truncate)
+ || eval {
+  chop($host = `uname -n 2>/dev/null`); ## sysVish && POSIXish
+ }
+
+ 
+ # method 5 - Apollo pre-SR10
+ || eval {
+  $host = (split(/[:\. ]/,`/com/host`,6))[0];
+ }
+
+ || eval {
+  $host = "";
+ };
+ 
+ # remove garbage 
+ $host =~ s/[\0\r\n]+//g;
+ $host =~ s/(\A\.+|\.+\Z)//g;
+ $host =~ s/\.\.+/\./;
+
+ $host;
+}
+
+sub _hostdomain {
+
+ ##
+ ## return imediately if we have already found the domainname;
+ ##
+
+ return $domain if(defined $domain);
+
+ ##
+ ## First attempt, just try hostname and system calls
+ ##
+
+ my $host = _hostname();
+ my($dom,$site,@hosts);
+ local($_);
+
+ @hosts = ($host,"localhost");
+
+ unless ($host =~ /\./){
+  eval {
+   chop($dom = `domainname 2>/dev/null`);
+  };
+  unshift(@hosts, "$host.$dom") if ($dom ne "");
+ }
+
+
+ foreach (@hosts) { # Attempt to locate FQDN
+  my @info = gethostbyname($_);
+  if(@info) {
+   foreach $site ($info[0], split(/ /,$info[1])) { # look at real name & aliases
+    if(rindex($site,".") > 0) {
+     ($domain = $site) =~ s/\A[^\.]+\.//; # Extract domain from FQDN
+     return $domain;
+    }
+   }
+  }
+ }
+
+ ##
+ ## try looking in /etc/resolv.conf
+ ##
+
+ local *RES;
+
+ if(open(RES,"/etc/resolv.conf")) {
+  while(<RES>) {
+   if(/\A\s*(?:domain|search)\s+(\S+)/) {
+    $domain = $1;
+   }
+  }
+  close(RES);
+
+  return $domain if(defined $domain);
+ }
+
+ ##
+ ## Look for environment variable
+ ##
+
+ return $domain = $ENV{DOMAIN} if(defined $ENV{DOMAIN});
+
+ $domain =~ s/[\r\n\0]+//g;
+ $domain =~ s/(\A\.+|\.+\Z)//g;
+ $domain =~ s/\.\.+/\./g;
+
+ $domain;
+}
+
+=head2 domainname()
+
+Identify and return the FQDN of the current host.
+
+=cut
+
+sub domainname {
+
+ return $fqdn if(defined $fqdn);
+
+ _hostname();
+ _hostdomain();
+
+ my @host   = split(/\./, $host);
+ my @domain = split(/\./, $domain);
+ my @fqdn   = ();
+
+ ##
+ ## Determine from @host & @domain the FQDN
+ ##
+
+ my @d = @domain;
+ 
+ LOOP:
+  while(1) {
+   my @h = @host;
+   while(@h) {
+    my $tmp = join(".",@h,@d);
+    if((gethostbyname($tmp))[0]) {
+     @fqdn = (@h,@d);
+     $fqdn = $tmp;
+     last LOOP;
+    }
+    pop @h;
+   }
+   last unless shift @d;
+  }
+
+ if(@fqdn) {
+  $host = shift @fqdn;
+  until((gethostbyname($host))[0]) {
+   $host .= "." . shift @fqdn;
+  }
+  $domain = join(".", @fqdn);
+ }
+ else {
+  undef $host;
+  undef $domain;
+  undef $fqdn;
+ }
+
+ $fqdn;
+}
+
+=head2 hostname()
+
+Returns the smallest part of the FQDN which can be used to identify the host.
+
+=cut
+
+sub hostname {
+ domainname() unless(defined $host);
+ return $host;
+ 
+}
+
+=head2 hostdomain()
+
+Returns the remainder of the FQDN after the I<hostname> has been removed
+
+=cut
+
+sub hostdomain {
+ domainname() unless(defined $domain);
+ return $domain;
+}
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995 Graham Barr. All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 REVISION
+
+$Revision: 1.6 $
+
+=head1 AUTHOR
+
+Graham Barr <bodg@tiuk.ti.com>
+
+=cut
+
+
+1; # Keep require happy
+
+__END__
+
+$Log: Domain.pm,v $
+# Revision 1.6  1995/11/16  11:57:04  gbarr
+# Changed package name to Net::Domain
+#
+# Revision 1.6  1995/11/16  11:57:04  gbarr
+# Changed package name to Net::Domain
+#
+# Revision 1.5  1995/09/11  10:55:55  gbarr
+# modified code to check all host name aliases
+# for a FQDN
+#
+# Revision 1.5  1995/09/11  10:55:55  gbarr
+# modified code to check all host name aliases
+# for a FQDN
+#
+# Revision 1.4  1995/09/06  06:08:42  gbarr
+# Applied patch from Matthew.Green@fulcrum.com.au to chop
+# results from `` commands
+#
+# Revision 1.3  1995/09/04  15:03:51  gbarr
+# changed the /etc/resolve.conf code to look for search and
+# domain parameters and use the last one found
+#
+# Revision 1.2  1995/09/04  11:22:59  gbarr
+# Added documentation
+#
+# Revision 1.1  1995/08/31  20:35:30  gbarr
+# Initial revision
+#
diff --git a/Net-Domain/Hostname.pm.eg b/Net-Domain/Hostname.pm.eg
new file mode 100644
index 0000000..4736c1a
--- /dev/null
+++ b/Net-Domain/Hostname.pm.eg
@@ -0,0 +1,14 @@
+#
+
+package Sys::Hostname;
+
+use Net::Domain qw(hostname);
+use Carp;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(hostname);
+
+carp "deprecated package 'Sys::Hostname', use Net::Domain" if $^W;
+
+1;
diff --git a/Net-Domain/MANIFEST b/Net-Domain/MANIFEST
new file mode 100644
index 0000000..741b31d
--- /dev/null
+++ b/Net-Domain/MANIFEST
@@ -0,0 +1,7 @@
+Domain.pm                        The package
+Hostname.pm.eg                        Example replacement for Sys::Hostname
+MANIFEST                        This file
+Makefile.PL                        MakeMaker source file
+README                                Information/Copyright etc
+t/hostname.t
+tst                                Test script
diff --git a/Net-Domain/Makefile.PL b/Net-Domain/Makefile.PL
new file mode 100644
index 0000000..28c0e40
--- /dev/null
+++ b/Net-Domain/Makefile.PL
@@ -0,0 +1,67 @@
+# This -*- perl -*- script makes the Makefile
+# $Id: Makefile.PL,v 1.4 1995/11/16 11:57:04 gbarr Exp $
+
+use ExtUtils::MakeMaker;
+use ExtUtils::Manifest qw(maniread);
+
+sub initialize {
+ local($_);
+
+ my $manifest = maniread();
+
+ $Version = eval { require "./Domain.pm"; Net::Domain->Version; } || "0.00";
+
+ my %pl_files = ();
+ my @exe_files = ();
+
+ foreach (keys %$manifest) {
+  $pl_files{$_} = $1 if(/(.*)\.PL\Z/ && !/^Makefile.PL$/);
+  push(@exe_files,$_) if(m#\bbin/# && !m#demo#);
+ }
+
+ my $hash = {
+        VERSION   => $Version,
+        NAME      => "Net::Domain",
+        SKIP      => [qw(static dynamic)],
+        PL_FILES  => \%pl_files,
+        EXE_FILES => \@exe_files,
+
+        'dist'    => {COMPRESS => 'gzip -9f',
+                      SUFFIX   => 'gz', 
+                      DIST_DEFAULT => 'all tardist',
+                      CI => 'ci -l'
+                     },
+
+        'linkext' => {LINKTYPE => '' },
+        'clean'   => {FILES => '*% *.html *.bak *.old lib/*% lib/*/*% $(EXE_FILES)'},
+ };
+
+ $hash;
+}
+
+if ($ExtUtils::MakeMaker::Version < 4.17) {
+ my $hash = initialize();
+ WriteMakefile( %$hash ) ;
+}
+else {
+ WriteMakefile( CONFIGURE => \&initialize ) ;
+}
+
+
+sub MY::test {
+    q{
+TEST_VERBOSE=0
+
+test:
+        $(FULLPERL) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e 'use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;' t/*.t
+
+};
+}
+
+sub MY::libscan {
+    return '' if m:/(RCS|CVS)/:;
+    return '' if m/[~%]$/;
+    return '' if m/\.(orig|rej)$/;
+    $_;
+}
+
diff --git a/Net-Domain/README b/Net-Domain/README
new file mode 100644
index 0000000..949b221
--- /dev/null
+++ b/Net-Domain/README
@@ -0,0 +1,21 @@
+
+Hostname.pm.eg is an example module that can be use in place of Sys::Hostname
+it will cause Sys::Hostname to use Net::Domain and if used in a perl -w
+will inform of the use of Sys::Hostname
+
+This package only C<attempts> to locate the current hostname and DNS domainname
+I cannot gaurantee that it will. It has been found at least once where
+a machine had no way at all of locating its FQDN. If this is so you
+results from the tst script included may look something like
+
+Domainname = hostname
+Hostname   = hostname
+Hostdomain = 
+
+
+Copyright (c) 1995 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
+reserved. This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Please report any bugs/suggestions to <Graham.Barr@tiuk.ti.com>.
+
diff --git a/Net-Domain/t/hostname.t b/Net-Domain/t/hostname.t
new file mode 100644
index 0000000..09eec59
--- /dev/null
+++ b/Net-Domain/t/hostname.t
@@ -0,0 +1,13 @@
+
+use Net::Domain qw(hostname domainname hostdomain);
+
+print "1..1\n";
+
+$domain = domainname();
+
+if(defined $domain && $domain ne "") {
+ print "ok 1\n";
+}
+else {
+ print "not ok 1\n";
+}
diff --git a/Net-Domain/tst b/Net-Domain/tst
new file mode 100755
index 0000000..eae753b
--- /dev/null
+++ b/Net-Domain/tst
@@ -0,0 +1,11 @@
+#!/usr/local/bin/perl -w
+
+use lib qw(./blib);
+use Net::Domain qw(hostname domainname hostdomain);
+
+print "Domainname = ",domainname(),"\n";
+print "Hostname   = ",hostname(),"\n";
+print "Hostdomain = ",hostdomain(),"\n";
+
+
+