#!/usr/bin/perl

use strict;
use Pod::Usage;
use Getopt::Long;

=pod

=head1 NAME

 basic_msnt_multi_domain_auth

=head1 SYNOPSIS

 basic_msnt_multi_domain_auth [options]

=head1 DESCRIPTION

B<basic_msnt_multi_domain_auth> is a Squid authenticator to check
user credentials against multiple NT domains using B<nmblookup>.

The user is expected to enter his/her credentials as domain\username
or domain/username (in analogy to what MS-Proxy does).

Requires Authen::SMB from CPAN and Samba if you need to perform NETBIOS
queries.

=head1 OPTIONS

=over 12

=item B<--debug>

Write debug info to stderr.

=item B<--wins-server>

Use the named WINS server.

 Default: broadcast will be attempted.

=item B<--no-fqdn>

Some servers don't like to be called by their fully qualified name.
Define this if you wish to call them ONLY by their hostname.

=item B<--no-rdns>

Some servers really really want to be called by address.

=back

=head1 AUTHOR

This program was written by I<Francesco Chemolli <kinkie@kame.usr.dsi.unimi.it>>

This manual was written by I<Amos Jeffries <squid3@treenet.co.nz>>

=head1 COPYRIGHT

 * Copyright (C) 1996-2016 The Squid Software Foundation and contributors
 *
 * Squid software is distributed under GPLv2+ license and includes
 * contributions from numerous individuals and organizations.
 * Please see the COPYING and CONTRIBUTORS files for details.

=head1 QUESTIONS

Questions on the usage of this program can be sent to the I<Squid Users mailing list <squid-users@squid-cache.org>>

=head1 REPORTING BUGS

Bug reports need to be made in English.
See http://wiki.squid-cache.org/SquidFaq/BugReporting for details of what you need to include with your bug report.

Report bugs or bug fixes using http://bugs.squid-cache.org/

Report serious security bugs to I<Squid Bugs <squid-bugs@squid-cache.org>>

Report ideas for new improvements to the I<Squid Developers mailing list <squid-dev@squid-cache.org>>

=head1 SEE ALSO

squid (8), GPL (7),

The Squid FAQ wiki http://wiki.squid-cache.org/SquidFaq

The Squid Configuration Manual http://www.squid-cache.org/Doc/config/

=cut

#to force using some DC for some domains, fill in this hash.
#the key is a regexp matched against the domain name
# the value is an array ref with PDC and BDC.
# the order the names are matched in is UNDEFINED.
#i.e.:
# %controllers = ( "domain" => ["pdc","bdc"]);

#%controllers = ( ".*" => ["pdcname","bdcname"]);

#no more user-serviceable parts

use Authen::Smb;

#variables: 
# %pdc used to cache the domain -> pdc_ip values. IT NEVER EXPIRES!

my $debug = undef;
my $wins_server = undef;
my $no_rdns = undef;
my $no_fqdn = undef;

GetOptions(
	'debug' => \$debug,
	'wins-server=s' => $wins_server,
	'no-fqdn' => $no_fqdn,
	'no-rdns' => $no_rdns
	);

$|=1;
while (<>) {
	chomp;
	if (! m;^(\S+)(/|%5c)(\S+)\s(\S+)$; ) { #parse the line
		print "ERR\n";
		next;
	}
	$domain=$1;
	$user=$3;
	$pass=$4;
	$domain =~ s/%([0-9a-f][0-9a-f])/pack("H2",$1)/gie;
        $user =~ s/%([0-9a-f][0-9a-f])/pack("H2",$1)/gie;
        $pass =~ s/%([0-9a-f][0-9a-f])/pack("H2",$1)/gie;
	print STDERR "domain: $domain, user: $user, pass=$pass\n" 
		if (defined ($debug));
	# check out that we know the PDC address
	if (!$pdc{$domain}) {
    ($pdc,$bdc)=&discover_dc($domain);
    if ($pdc) {
      $pdc{$domain}=$pdc;
      $bdc{$domain}=$bdc;
    }
	}
	$pdc=$pdc{$domain};
	$bdc=$bdc{$domain};
	if (!$pdc) {
		#a pdc was not found
		print "ERR\n";
		print STDERR "No PDC found\n" if (defined($debug));
		next;
	}

  print STDERR "querying '$pdc' and '$bdc' for user '$domain\\$user', ".
    "pass $pass\n" if (defined($debug));
  $result=Authen::Smb::authen($user,$pass,$pdc,$bdc,$domain);
  print STDERR "result is: $nt_results{$result} ($result)\n"
    if (defined($debug));
  if ($result == NTV_NO_ERROR) {
    print STDERR ("OK for user '$domain\\$user'\n") if (defined($debug));
    print ("OK\n");
  } else {
    print STDERR "Could not authenticate user '$domain\\$user'\n";
    print ("ERR\n");
  }
}

#why do Microsoft servers have to be so damn picky and convoluted?
sub discover_dc {
  my $domain = shift @_;
  my ($pdc, $bdc, $lookupstring, $datum);

  foreach (keys %controllers) {
    if ($domain =~ /$_/) {
      print STDERR "DCs forced by user: $_ => ".
        join(',',@{$controllers{$_}}).
        "\n" if (defined($debug));
      return @{$controllers{$_}};
    }
  }
  $lookupstring="nmblookup";
  $lookupstring.=" -R -U $wins_server" if (defined($wins_server));
  $lookupstring.=" -T" unless (defined($no_rdns));
  $lookupstring.=" '$domain#1c'";
  print STDERR "Discovering PDC: $lookupstring\n"
    if (defined($debug));
  #discover the PDC address
  open(PDC,"$lookupstring|");
  while (<PDC>) {
    print STDERR "response line: $_" if (defined($debug));
    if (m|(.*), (\d+\.\d+\.\d+\.\d+)|) {
      $datum=$1;
      print STDERR "matched $datum\n" if (defined($debug));
      if (defined($no_fqdn) && $datum =~ /^([^.]+)\..*/) {
        $datum=$1;
        print STDERR "stripped domain name: $datum\n" if (defined($debug));
      }
    } elsif (m|^(\d+\.\d+\.\d+\.\d+)|) {
      $datum=$1;
    } else {
      #no data here, go to next line
      next;
    }
    if ($datum) {
      if ($pdc) {
        $bdc=$datum;
        print STDERR "BDC is $datum\n" if (defined($debug));
        last;
      }	else {
        $pdc=$datum;
        print STDERR "PDC is $datum\n" if (defined($debug));
      }
      last;
    }
  }
  close(PDC);
  return ($pdc,$bdc) if ($pdc);
  return 0;
}