home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / maildomain.al < prev    next >
Encoding:
Text File  |  2004-03-29  |  2.1 KB  |  112 lines
  1. # NOTE: Derived from blib\lib\Mail/Util.pm.
  2. # Changes made here will be lost when autosplit is run again.
  3. # See AutoSplit.pm.
  4. package Mail::Util;
  5.  
  6. #line 131 "blib\lib\Mail/Util.pm (autosplit into blib\lib\auto\Mail\Util\maildomain.al)"
  7. sub maildomain {
  8.  
  9.     ##
  10.     ## return imediately if already found
  11.     ##
  12.  
  13.     return $domain
  14.     if(defined $domain);
  15.  
  16.     ##
  17.     ## Get mail domain from environment
  18.     ##
  19.  
  20.     $domain = $ENV{MAILDOMAIN};
  21.  
  22.     return $domain
  23.        if(defined $domain);
  24.  
  25.     ##
  26.     ## Try sendmail config file if exists
  27.     ##
  28.  
  29.     local *CF;
  30.     local $_;
  31.     my @sendmailcf = qw(/etc
  32.             /etc/sendmail
  33.             /etc/ucblib
  34.             /etc/mail
  35.             /usr/lib
  36.             /var/adm/sendmail);
  37.  
  38.     my $config = (grep(-r, map("$_/sendmail.cf", @sendmailcf)))[0];
  39.  
  40.     if(defined $config && open(CF,$config)) {
  41.     my %var;
  42.     while(<CF>) {
  43.         if(my ($v, $arg) = /^D([a-zA-Z])([\w.\$\-]+)/) {
  44.         $arg =~ s/\$([a-zA-Z])/exists $var{$1} ? $var{$1} : '$'.$1/eg;
  45.         $var{$v} = $arg;
  46.         }
  47.     }
  48.     close(CF);
  49.     $domain = $var{j} if defined $var{j};
  50.     $domain = $var{M} if defined $var{M};
  51.  
  52.         $domain = $1
  53.             if($domain && $domain =~ m/([A-Za-z0-9](?:[\.\-A-Za-z0-9]+))/ );
  54.  
  55.     return $domain
  56.         if(defined $domain);
  57.     }
  58.  
  59.     ##
  60.     ## Try smail config file if exists
  61.     ##
  62.  
  63.     if(open(CF,"/usr/lib/smail/config")) {
  64.     while(<CF>) {
  65.         if(/\A\s*hostnames?\s*=\s*(\S+)/) {
  66.         $domain = (split(/:/,$1))[0];
  67.         last;
  68.         }
  69.     }
  70.     close(CF);
  71.  
  72.     return $domain
  73.         if(defined $domain);
  74.     }
  75.  
  76.     ##
  77.     ## Try a SMTP connection to 'mailhost'
  78.     ##
  79.  
  80.     if(eval { require Net::SMTP }) {
  81.     my $host;
  82.  
  83.     foreach $host (qw(mailhost localhost)) {
  84.         my $smtp = eval { Net::SMTP->new($host) };
  85.  
  86.         if(defined $smtp) {
  87.         $domain = $smtp->domain;
  88.         $smtp->quit;
  89.         last;
  90.         }
  91.     }
  92.     }
  93.  
  94.     ##
  95.     ## Use internet(DNS) domain name, if it can be found
  96.     ##
  97.  
  98.     unless(defined $domain) {
  99.     if(eval { require Net::Domain } ) {
  100.         $domain = Net::Domain::domainname();
  101.     }
  102.     }
  103.  
  104.     $domain = "localhost"
  105.     unless(defined $domain);
  106.  
  107.     return $domain;
  108. }
  109.  
  110. # end of Mail::Util::maildomain
  111. 1;
  112.