3 ## Copyright (C) 1996-2023 The Squid Software Foundation and contributors
5 ## Squid software is distributed under GPLv2+ license and includes
6 ## contributions from numerous individuals and organizations.
7 ## Please see the COPYING and CONTRIBUTORS files for details.
10 # (C) 2000 Francesco Chemolli <kinkie@kame.usr.dsi.unimi.it>
11 # Distributed freely under the terms of the GNU General Public License,
12 # version 2 or later. For the licensing terms, see the file COPYING that
15 # This is a dummy NTLM authentication module for Squid.
16 # It performs the NTLM challenge, but then it doesn't verify the
17 # user's credentials, it just takes the client's domain and username
19 # It's included mostly for demonstration purposes.
21 # TODO: use command-line arguments
26 #$authdomain="your_domain_goes_here";
27 $challenge="deadbeef";
29 $authdomain=$ARGV[0] if ($#ARGV >=0);
31 die ("Edit $0 to configure a domain!") unless (defined($authdomain));
35 if (substr($_, 0, 2) eq "YR") {
36 print "TT ".encode_base64
(&make_ntlm_static_challenge
);
40 %res=decode_ntlm_any
(decode_base64
($got));
41 # print STDERR "got: ".hash_to_string(%res);
42 if (!res
) { # broken NTLM, deny
43 print "BH Couldn't decode NTLM packet\n";
46 if ($res{type
} eq "negotiate") { # ok, send a challenge
47 print "BH Squid-helper protocol error: unexpected negotiate-request\n";
50 if ($res{type
} eq "challenge") { # Huh? WE are the challengers.
51 print "BH Squid-helper protocol error: unexpected challenge-request\n";
54 if ($res{type
} eq "authentication") {
55 print "AF $res{domain}\\$res{user}\n";
58 print "BH internal error\n"; # internal error
62 sub make_ntlm_static_challenge
{
63 $rv = pack ("a8 V", "NTLMSSP", 0x2);
66 $rv .= add_to_data
(uc($authdomain),\
$payload);
67 $rv .= pack ("V Z8 v8", 0x18206, $challenge,0,0,0,0,0,0,0x3a,0);
68 #flags, challenge, 8 bytes of unknown stuff
73 #gets as argument the decoded authenticate packet.
74 #returns either undef (failure to decode) or an hash with the decoded
76 sub decode_ntlm_authentication
{
78 my ($signature, $type, %rv, $hdr, $rest);
79 ($signature, $type, $rest) = unpack ("a8 V a*",$got);
80 return unless ($signature eq "NTLMSSP\0");
81 return unless ($type == 0x3);
82 $rv{type
}="authentication";
83 ($hdr, $rest) = unpack ("a8 a*", $rest);
84 $rv{lmresponse
}=get_from_data
($hdr,$got);
85 ($hdr, $rest) = unpack ("a8 a*", $rest);
86 $rv{ntresponse
}=get_from_data
($hdr,$got);
87 ($hdr, $rest) = unpack ("a8 a*", $rest);
88 $rv{domain
}=get_from_data
($hdr,$got);
89 ($hdr, $rest) = unpack ("a8 a*", $rest);
90 $rv{user
}=get_from_data
($hdr,$got);
91 ($hdr, $rest) = unpack ("a8 a*", $rest);
92 $rv{workstation
}=get_from_data
($hdr,$got);
93 ($hdr, $rest) = unpack ("a8 a*", $rest);
94 $rv{sessionkey
}=get_from_data
($hdr,$got);
95 $rv{flags
}=unpack("V",$rest);
99 #args: len, maxlen, offset
101 return pack ("v v V", @_);
104 #args: string to add, ref to payload
105 # returns ntlm header.
107 my ($toadd, $pl) = @_;
109 # $toadd.='\0' unless ($toadd[-1]=='\0'); #broken
110 $offset=48+length $pl; #48 is the length of the header
112 return make_ntlm_hdr
(length $toadd, length $toadd, $offset);
115 #args: encoded descriptor, entire decoded packet
116 # returns the decoded data
118 my($desc,$packet) = @_;
119 my($offset,$length, $rv);
120 ($length, undef, $offset) = unpack ("v v V", $desc);
121 return unless ($length+$offset <= length $packet);
122 $rv = unpack ("x$offset a$length",$packet);
129 foreach (sort keys %hash) {
130 $rv.=$_." => ".$hash{$_}."\n";
136 #more decoder functions, added more for debugging purposes
137 #than for any real use in the application.
138 #args: the base64-decoded packet
139 #returns: either undef or an hash describing the packet.
140 sub decode_ntlm_negotiate
{
142 my($signature, $type, %rv, $hdr, $rest);
143 ($signature, $type, $rest) = unpack ("a8 V a*",$got);
144 return unless ($signature eq "NTLMSSP\0");
145 return unless ($type == 0x1);
146 $rv{type
}="negotiate";
147 ($rv{flags
}, $rest)=unpack("V a*",$rest);
148 ($hdr, $rest) = unpack ("a8 a*", $rest);
149 $rv{domain
}=get_from_data
($hdr,$got);
150 ($hdr, $rest) = unpack ("a8 a*", $rest);
151 $rv{workstation
}=get_from_data
($hdr,$got);
155 sub decode_ntlm_challenge
{
157 my($signature, $type, %rv, $hdr, $rest, $j);
158 ($signature, $type, $rest) = unpack ("a8 V a*",$got);
159 return unless ($signature eq "NTLMSSP\0");
160 return unless ($type == 0x2);
161 $rv{type
}="challenge";
162 ($rv{flags
}, $rest)=unpack("V a*",$rest);
163 ($rv{challenge
}, $rest)=unpack("a8 a*",$rest);
164 for ($j=0;$j<8;$j++) { # don't shoot on the programmer, please.
165 ($rv{"context.$j"},$rest)=unpack("v a*",$rest);
170 #decodes any NTLMSSP packet.
171 #arg: the encoded packet, returns an hash with packet info
172 sub decode_ntlm_any
{
174 my ($signature, $type);
175 ($signature, $type, undef) = unpack ("a8 V a*",$got);
176 return unless ($signature eq "NTLMSSP\0");
177 return decode_ntlm_negotiate
($got) if ($type == 1);
178 return decode_ntlm_challenge
($got) if ($type == 2);
179 return decode_ntlm_authentication
($got) if ($type == 3);
180 return undef; # default
186 sub encode_base64
($;$)
190 $eol = "\n" unless defined $eol;
191 pos($_[0]) = 0; # ensure start at the beginning
192 while ($_[0] =~ /(.{1,45})/gs) {
193 $res .= substr(pack('u', $1), 1);
196 $res =~ tr
|` -_|AA-Za-z0-9+/|; # `# help emacs
197 # fix padding at the end
198 my $padding = (3 - length($_[0]) % 3) % 3;
199 $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
200 # break encoded string into lines of no more than 76 characters each
202 $res =~ s/(.{1,76})/$1$eol/g;
208 sub decode_base64
($)
210 local($^W
) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
215 $str =~ tr
|A
-Za
-z0
-9+=/||cd
; # remove non-base64 chars
216 if (length($str) % 4) {
218 Carp
::carp
("Length of base64 data not a multiple of 4")
220 $str =~ s/=+$//; # remove padding
221 $str =~ tr
|A
-Za
-z0
-9+/| -_
|; # convert to uuencoded format
222 while ($str =~ /(.{1,60})/gs) {
223 my $len = chr(32 + length($1)*3/4); # compute length byte
224 $res .= unpack("u", $len . $1 ); # uudecode