← Back to branch summary

~squid/squid/sbuf-use

« back to all changes in this revision

Viewing changes to helpers/basic_auth/multi-domain-NTLM/smb_auth.pl

  • Committer: hno
  • Date: 2001-01-08 06:32:04 UTC
  • Revision ID: cvs-1:hno-20010108063204-w6a8e1zz6eprqnp8
Major rewrite of proxy authentication to support other schemes than
Basic (auth_rewrite branch on SourceForge).
Contributors:
   Andy Doran
   Robert Collins
   Chemolli Francesco
   Henrik Nordstrom

For details about the new API's, see Programmers Guide.

As part of this change everything from auth_modules has been moved to
src/auth/basic/helpers

Show diffs side-by-side

added added

removed removed

Lines of Context:
helpers/basic_auth/multi-domain-NTLM/smb_auth.pl
 
1
#!/usr/bin/perl
 
2
 
 
3
#if you define this, debugging output will be printed to STDERR.
 
4
$debug=1;
 
5
 
 
6
#to force using some DC for some domains, fill in this hash.
 
7
#the key is a regexp matched against the domain name
 
8
# the value is an array ref with PDC and BDC.
 
9
# the order the names are matched in is UNDEFINED.
 
10
#i.e.:
 
11
# %controllers = ( "domain" => ["pdc","bdc"]);
 
12
 
 
13
#%controllers = ( ".*" => ["tlc5",undef]);
 
14
 
 
15
#define this if you wish to use a WINS server. If undefined, broadcast
 
16
# will be attempted.
 
17
$wins_server="c0wins";
 
18
 
 
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
while (<>) {
 
40
        if (! m;([^\\]+)(\\|/)(\S+)\s(.*); ) { #parse the line
 
41
                print "ERR\n";
 
42
                next;
 
43
        }
 
44
        $domain=$1;
 
45
        $user=$3;
 
46
        $pass=$4;
 
47
        print STDERR "domain: $domain, user: $user, pass=$pass\n" 
 
48
                if (defined ($debug));
 
49
        # check out that we know the PDC address
 
50
        if (!$pdc{$domain}) {
 
51
    ($pdc,$bdc)=&discover_dc($domain);
 
52
    if ($pdc) {
 
53
      $pdc{$domain}=$pdc;
 
54
      $bdc{$domain}=$bdc;
 
55
    }
 
56
        }
 
57
        $pdc=$pdc{$domain};
 
58
        $bdc=$bdc{$domain};
 
59
        if (!$pdc) {
 
60
                #a pdc was not found
 
61
                print "ERR\n";
 
62
                print STDERR "No PDC found\n" if (defined($debug));
 
63
                next;
 
64
        }
 
65
 
 
66
  print STDERR "querying '$pdc' and '$bdc' for user '$domain\\$user', ".
 
67
    "pass $pass\n" if (defined($debug));
 
68
  $result=Authen::Smb::authen($user,$pass,$pdc,$bdc,$domain);
 
69
  print STDERR "result is: $nt_results{$result} ($result)\n"
 
70
    if (defined($debug));
 
71
  if ($result == NTV_NO_ERROR) {
 
72
    print STDERR ("OK for user '$domain\\$user'\n") if (defined($debug));
 
73
    print ("OK\n");
 
74
  } else {
 
75
    print STDERR "Could not authenticate user '$domain\\$user'\n";
 
76
    print ("ERR\n");
 
77
  }
 
78
}
 
79
 
 
80
#why do Microsoft servers have to be so damn picky and convoluted?
 
81
sub discover_dc {
 
82
  my $domain = shift @_;
 
83
  my ($pdc, $bdc, $lookupstring, $datum);
 
84
 
 
85
  foreach (keys %controllers) {
 
86
    if ($domain =~ /$_/) {
 
87
      print STDERR "DCs forced by user: $_ => ".
 
88
        join(',',@{$controllers{$_}}).
 
89
        "\n" if (defined($debug));
 
90
      return @{$controllers{$_}};
 
91
    }
 
92
  }
 
93
  $lookupstring="nmblookup";
 
94
  $lookupstring.=" -R -U $wins_server" if (defined($wins_server));
 
95
  $lookupstring.=" -T" if (defined($try_reverse_dns));
 
96
  $lookupstring.=" '$domain#1c'";
 
97
  print STDERR "Discovering PDC: $lookupstring\n"
 
98
    if (defined($debug));
 
99
  #discover the PDC address
 
100
  open(PDC,"$lookupstring|");
 
101
  while (<PDC>) {
 
102
    print STDERR "response line: $_" if (defined($debug));
 
103
    if (m|(.*), (\d+\.\d+\.\d+\.\d+)|) {
 
104
      $datum=$1;
 
105
      print STDERR "matched $datum\n" if (defined($debug));
 
106
      if (defined($dont_use_fqdn) && $datum =~ /^([^.]+)\..*/) {
 
107
        $datum=$1;
 
108
        print STDERR "stripped domain name: $datum\n" if (defined($debug));
 
109
      }
 
110
    } elsif (m|^(\d+\.\d+\.\d+\.\d+)|) {
 
111
      $datum=$1;
 
112
    } else {
 
113
      #no data here, go to next line
 
114
      next;
 
115
    }
 
116
    if ($datum) {
 
117
      if ($pdc) {
 
118
        $bdc=$datum;
 
119
        print STDERR "BDC is $datum\n" if (defined($debug));
 
120
        last;
 
121
      } else {
 
122
        $pdc=$datum;
 
123
        print STDERR "PDC is $datum\n" if (defined($debug));
 
124
      }
 
125
      last;
 
126
    }
 
127
  }
 
128
  close(PDC);
 
129
  return ($pdc,$bdc) if ($pdc);
 
130
  return 0;
 
131
}
 
132