---------------------
PatchSet 491 
Date: 2000/08/03 11:47:59
Author: kinkie
Branch: ntlm
Tag: (none) 
Log:
Dummy NTLM authentication module.
Mostly useful as a (working) sample.

Members: 
	ntlm_auth_modules/no_check/README.no_check_ntlm_auth:1.1->1.1.2.1 
	ntlm_auth_modules/no_check/no_check:1.1->1.1.2.1 

--- /dev/null	Wed Feb 14 00:44:43 2007
+++ squid/ntlm_auth_modules/no_check/README.no_check_ntlm_auth	Wed Feb 14 00:45:14 2007
@@ -0,0 +1,10 @@
+This is a dummy NTLM authentication module for Squid.
+It performs the NTLM challenge, but then it doesn't verify the
+user's credentials, it just takes the client's domain and username
+at face value.
+It's included mostly for demonstration purposes.
+
+(C) 2000 Francesco Chemolli <kinkie@kame.usr.dsi.unimi.it>
+Distributed freely under the terms of the GNU General Public License, 
+version 2. For the licensing terms, see the file COPYING that
+came with Squid.
--- /dev/null	Wed Feb 14 00:44:43 2007
+++ squid/ntlm_auth_modules/no_check/no_check	Wed Feb 14 00:45:14 2007
@@ -0,0 +1,206 @@
+#!/usr/bin/perl
+# (C) 2000 Francesco Chemolli <kinkie@kame.usr.dsi.unimi.it>
+#
+# TODO: use command-line arguments
+
+#use MIME::Base64;
+
+$|=1;
+#$authdomain="your_domain_goes_here";
+$challenge="deadbeef";
+
+die ("Edit $0 to configure a domain!") unless (defined($authdomain));
+
+while(<>) {
+	if ($_ eq "RESET") {
+		print "RESET OK\n";
+		next;
+	}
+	%res=decode_ntlm_any(decode_base64($_));
+#	print STDERR "got: ".hash_to_string(%res);
+	if (!res) {										# broken NTLM, deny
+		print "ERR\n";
+		next;
+	}
+	if ($res{type} eq "negotiate") { # ok, send a challenge
+		print "CH ".encode_base64(&make_ntlm_static_challenge);
+		next;
+	}
+	if ($res{type} eq "challenge") { # Huh? WE are the challengers.
+		print "ERR\n";
+		next;		
+	}
+	if ($res{type} eq "authentication") {
+		print "OK $res{domain}\\$res{user}\n";
+		next;		
+	}
+	print "ERR\n";								# internal error
+}
+
+
+sub make_ntlm_static_challenge {
+	$rv = pack ("a8 V", "NTLMSSP", 0x2);
+	$payload = "";
+
+	$rv .= add_to_data(uc($authdomain),\$payload);
+	$rv .= pack ("V Z8 v8", 0x18206, $challenge,0,0,0,0,0,0,0x3a,0);
+	#flags, challenge, 8 bytes of unknown stuff
+
+	return $rv.$payload;
+}
+
+#gets as argument the decoded authenticate packet.
+#returns either undef (failure to decode) or an hash with the decoded
+# fields.
+sub decode_ntlm_authentication {
+	my ($got)=$_[0];
+	my ($signature, $type, %rv, $hdr, $rest);
+	($signature, $type, $rest) = unpack ("a8 V a*",$got);
+	return unless ($signature eq "NTLMSSP\0");
+	return unless ($type == 0x3);
+	$rv{type}="authentication";
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{lmresponse}=get_from_data($hdr,$got);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{ntresponse}=get_from_data($hdr,$got);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{domain}=get_from_data($hdr,$got);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{user}=get_from_data($hdr,$got);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{workstation}=get_from_data($hdr,$got);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{sessionkey}=get_from_data($hdr,$got);
+	$rv{flags}=unpack("V",$rest);
+	return %rv;
+}
+
+#args: len, maxlen, offset
+sub make_ntlm_hdr {
+	return pack ("v v V", @_);
+}
+
+#args: string to add, ref to payload
+# returns ntlm header.
+sub add_to_data {
+	my ($toadd, $pl) = @_;
+	my ($offset);
+#	$toadd.='\0' unless ($toadd[-1]=='\0'); #broken
+	$offset=48+length $pl;  #48 is the length of the header
+	$$pl.=$toadd;
+	return make_ntlm_hdr (length $toadd, length $toadd, $offset);
+}
+
+#args: encoded descriptor, entire decoded packet
+# returns the decoded data
+sub get_from_data {
+	my($desc,$packet) = @_;
+	my($offset,$length, $rv);
+	($length, undef, $offset) = unpack ("v v V", $desc);
+	return unless ($length+$offset <= length $packet);
+	$rv = unpack ("x$offset a$length",$packet);
+	return $rv;
+}
+
+sub hash_to_string {
+	my (%hash) = @_;
+	my ($rv);
+	foreach (sort keys %hash) {
+		$rv.=$_." => ".$hash{$_}."\n";
+	}
+	return $rv;
+}
+
+
+#more decoder functions, added more for debugging purposes
+#than for any real use in the application.
+#args: the base64-decoded packet
+#returns: either undef or an hash describing the packet.
+sub decode_ntlm_negotiate {
+	my($got)=$_[0];
+	my($signature, $type, %rv, $hdr, $rest);
+	($signature, $type, $rest) = unpack ("a8 V a*",$got);
+	return unless ($signature eq "NTLMSSP\0");
+	return unless ($type == 0x1);
+	$rv{type}="negotiate";
+	($rv{flags}, $rest)=unpack("V a*",$rest);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{domain}=get_from_data($hdr,$got);
+	($hdr, $rest) = unpack ("a8 a*", $rest);
+	$rv{workstation}=get_from_data($hdr,$got);
+	return %rv;
+}
+
+sub decode_ntlm_challenge {
+	my($got)=$_[0];
+	my($signature, $type, %rv, $hdr, $rest, $j);
+	($signature, $type, $rest) = unpack ("a8 V a*",$got);
+	return unless ($signature eq "NTLMSSP\0");
+	return unless ($type == 0x2);
+	$rv{type}="challenge";
+	($rv{flags}, $rest)=unpack("V a*",$rest);
+	($rv{challenge}, $rest)=unpack("a8 a*",$rest);
+	for ($j=0;$j<8;$j++) {				# don't shoot on the programmer, please.
+		($rv{"context.$j"},$rest)=unpack("v a*",$rest);
+	}
+	return %rv;
+}
+
+#decodes any NTLMSSP packet.
+#arg: the encoded packet, returns an hash with packet info
+sub decode_ntlm_any {
+	my($got)=$_[0];
+	my ($signature, $type);
+	($signature, $type, undef) = unpack ("a8 V a*",$got);
+	return unless ($signature eq "NTLMSSP\0");
+	return decode_ntlm_negotiate($got) if ($type == 1);
+	return decode_ntlm_challenge($got) if ($type == 2);
+	return decode_ntlm_authentication($got) if ($type == 3);
+	return undef;									# default
+}
+
+
+use integer;
+
+sub encode_base64 ($;$)
+{
+    my $res = "";
+    my $eol = $_[1];
+    $eol = "\n" unless defined $eol;
+    pos($_[0]) = 0;                          # ensure start at the beginning
+    while ($_[0] =~ /(.{1,45})/gs) {
+	$res .= substr(pack('u', $1), 1);
+	chop($res);
+    }
+    $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
+    # fix padding at the end
+    my $padding = (3 - length($_[0]) % 3) % 3;
+    $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
+    # break encoded string into lines of no more than 76 characters each
+    if (length $eol) {
+	$res =~ s/(.{1,76})/$1$eol/g;
+    }
+    $res;
+}
+
+
+sub decode_base64 ($)
+{
+    local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
+
+    my $str = shift;
+    my $res = "";
+
+    $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
+    if (length($str) % 4) {
+	require Carp;
+	Carp::carp("Length of base64 data not a multiple of 4")
+    }
+    $str =~ s/=+$//;                        # remove padding
+    $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
+    while ($str =~ /(.{1,60})/gs) {
+	my $len = chr(32 + length($1)*3/4); # compute length byte
+	$res .= unpack("u", $len . $1 );    # uudecode
+    }
+    $res;
+}