helpers/basic_auth/multi-domain-NTLM/smb_auth.pl

   1 #!/usr/bin/perl
   2 # $Id$
   3
   4 #if you define this, debugging output will be printed to STDERR.
   5 #$debug=1;
   6
   7 #to force using some DC for some domains, fill in this hash.
   8 #the key is a regexp matched against the domain name
   9 # the value is an array ref with PDC and BDC.
  10 # the order the names are matched in is UNDEFINED.
  11 #i.e.:
  12 # %controllers = ( "domain" => ["pdc","bdc"]);
  13
  14 #%controllers = ( ".*" => ["pdcname","bdcname"]);
  15
  16 #define this if you wish to use a WINS server. If undefined, broadcast
  17 # will be attempted.
  18 #$wins_server="winsservername";
  19
  20 # Some servers (at least mine) really really want to be called by address.
  21 # If this variable is defined, we'll ask nmblookup to do a reverse DNS on the
  22 #  DC addresses. It might fail though, for instance because you have a crappy
  23 #  DNS with no reverse zones or records. If it doesn't work, you'll have to
  24 #  fall back to the %controllers hack.
  25 $try_reverse_dns=1;
  26
  27 # Soem servers (at least mine) don't like to be called by their fully
  28 #  qualified name. define this if you wish to call them ONLY by their
  29 #  hostname.
  30 $dont_use_fqdn=1;
  31
  32 #no more user-serviceable parts
  33 use Authen::Smb;
  34
  35 #variables:
  36 # %pdc used to cache the domain -> pdc_ip values. IT NEVER EXPIRES!
  37
  38
  39 $|=1;
  40 while (<>) {
  41         chomp;
  42         if (! m;^(\S+)(/|%5c)(\S+)\s(\S+)$; ) { #parse the line
  43                 print "ERR\n";
  44                 next;
  45         }
  46         $domain=$1;
  47         $user=$3;
  48         $pass=$4;
  49         $domain =~ s/%([0-9a-f][0-9a-f])/pack("H2",$1)/gie;
  50         $user =~ s/%([0-9a-f][0-9a-f])/pack("H2",$1)/gie;
  51         $pass =~ s/%([0-9a-f][0-9a-f])/pack("H2",$1)/gie;
  52         print STDERR "domain: $domain, user: $user, pass=$pass\n"
  53                 if (defined ($debug));
  54         # check out that we know the PDC address
  55         if (!$pdc{$domain}) {
  56     ($pdc,$bdc)=&discover_dc($domain);
  57     if ($pdc) {
  58       $pdc{$domain}=$pdc;
  59       $bdc{$domain}=$bdc;
  60     }
  61         }
  62         $pdc=$pdc{$domain};
  63         $bdc=$bdc{$domain};
  64         if (!$pdc) {
  65                 #a pdc was not found
  66                 print "ERR\n";
  67                 print STDERR "No PDC found\n" if (defined($debug));
  68                 next;
  69         }
  70
  71   print STDERR "querying '$pdc' and '$bdc' for user '$domain\\$user', ".
  72     "pass $pass\n" if (defined($debug));
  73   $result=Authen::Smb::authen($user,$pass,$pdc,$bdc,$domain);
  74   print STDERR "result is: $nt_results{$result} ($result)\n"
  75     if (defined($debug));
  76   if ($result == NTV_NO_ERROR) {
  77     print STDERR ("OK for user '$domain\\$user'\n") if (defined($debug));
  78     print ("OK\n");
  79   } else {
  80     print STDERR "Could not authenticate user '$domain\\$user'\n";
  81     print ("ERR\n");
  82   }
  83 }
  84
  85 #why do Microsoft servers have to be so damn picky and convoluted?
  86 sub discover_dc {
  87   my $domain = shift @_;
  88   my ($pdc, $bdc, $lookupstring, $datum);
  89
  90   foreach (keys %controllers) {
  91     if ($domain =~ /$_/) {
  92       print STDERR "DCs forced by user: $_ => ".
  93         join(',',@{$controllers{$_}}).
  94         "\n" if (defined($debug));
  95       return @{$controllers{$_}};
  96     }
  97   }
  98   $lookupstring="nmblookup";
  99   $lookupstring.=" -R -U $wins_server" if (defined($wins_server));
 100   $lookupstring.=" -T" if (defined($try_reverse_dns));
 101   $lookupstring.=" '$domain#1c'";
 102   print STDERR "Discovering PDC: $lookupstring\n"
 103     if (defined($debug));
 104   #discover the PDC address
 105   open(PDC,"$lookupstring|");
 106   while (<PDC>) {
 107     print STDERR "response line: $_" if (defined($debug));
 108     if (m|(.*), (\d+\.\d+\.\d+\.\d+)|) {
 109       $datum=$1;
 110       print STDERR "matched $datum\n" if (defined($debug));
 111       if (defined($dont_use_fqdn) && $datum =~ /^([^.]+)\..*/) {
 112         $datum=$1;
 113         print STDERR "stripped domain name: $datum\n" if (defined($debug));
 114       }
 115     } elsif (m|^(\d+\.\d+\.\d+\.\d+)|) {
 116       $datum=$1;
 117     } else {
 118       #no data here, go to next line
 119       next;
 120     }
 121     if ($datum) {
 122       if ($pdc) {
 123         $bdc=$datum;
 124         print STDERR "BDC is $datum\n" if (defined($debug));
 125         last;
 126       } else {
 127         $pdc=$datum;
 128         print STDERR "PDC is $datum\n" if (defined($debug));
 129       }
 130       last;
 131     }
 132   }
 133   close(PDC);
 134   return ($pdc,$bdc) if ($pdc);
 135   return 0;
 136 }
 137