~clint-fewbar/ubuntu/precise/squid3/ignore-sighup-early

« back to all changes in this revision

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

  • Committer: Bazaar Package Importer
  • Author(s): Luigi Gangitano
  • Date: 2006-11-11 10:32:06 UTC
  • Revision ID: james.westby@ubuntu.com-20061111103206-f3p0r9g0vq44rp3r
Tags: upstream-3.0.PRE5
ImportĀ upstreamĀ versionĀ 3.0.PRE5

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
#!/usr/bin/perl
 
2
# $Id: smb_auth.pl,v 1.5 2003/05/17 17:13:05 hno Exp $
 
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