1#!@PERL@ 2# 3## Copyright (C) 1996-2021 The Squid Software Foundation and contributors 4## 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. 8## 9# 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 13# came with Squid. 14# 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 18# at face value. 19# It's included mostly for demonstration purposes. 20# 21# TODO: use command-line arguments 22 23#use MIME::Base64; 24 25$|=1; 26#$authdomain="your_domain_goes_here"; 27$challenge="deadbeef"; 28 29$authdomain=$ARGV[0] if ($#ARGV >=0); 30 31die ("Edit $0 to configure a domain!") unless (defined($authdomain)); 32 33while(<STDIN>) { 34 chop; 35 if (substr($_, 0, 2) eq "YR") { 36 print "TT ".encode_base64(&make_ntlm_static_challenge); 37 next; 38 } 39 $got=substr($_,3); 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"; 44 next; 45 } 46 if ($res{type} eq "negotiate") { # ok, send a challenge 47 print "BH Squid-helper protocol error: unexpected negotiate-request\n"; 48 next; 49 } 50 if ($res{type} eq "challenge") { # Huh? WE are the challengers. 51 print "BH Squid-helper protocol error: unexpected challenge-request\n"; 52 next; 53 } 54 if ($res{type} eq "authentication") { 55 print "AF $res{domain}\\$res{user}\n"; 56 next; 57 } 58 print "BH internal error\n"; # internal error 59} 60 61 62sub make_ntlm_static_challenge { 63 $rv = pack ("a8 V", "NTLMSSP", 0x2); 64 $payload = ""; 65 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 69 70 return $rv.$payload; 71} 72 73#gets as argument the decoded authenticate packet. 74#returns either undef (failure to decode) or an hash with the decoded 75# fields. 76sub decode_ntlm_authentication { 77 my ($got)=$_[0]; 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); 96 return %rv; 97} 98 99#args: len, maxlen, offset 100sub make_ntlm_hdr { 101 return pack ("v v V", @_); 102} 103 104#args: string to add, ref to payload 105# returns ntlm header. 106sub add_to_data { 107 my ($toadd, $pl) = @_; 108 my ($offset); 109# $toadd.='\0' unless ($toadd[-1]=='\0'); #broken 110 $offset=48+length $pl; #48 is the length of the header 111 $$pl.=$toadd; 112 return make_ntlm_hdr (length $toadd, length $toadd, $offset); 113} 114 115#args: encoded descriptor, entire decoded packet 116# returns the decoded data 117sub get_from_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); 123 return $rv; 124} 125 126sub hash_to_string { 127 my (%hash) = @_; 128 my ($rv); 129 foreach (sort keys %hash) { 130 $rv.=$_." => ".$hash{$_}."\n"; 131 } 132 return $rv; 133} 134 135 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. 140sub decode_ntlm_negotiate { 141 my($got)=$_[0]; 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); 152 return %rv; 153} 154 155sub decode_ntlm_challenge { 156 my($got)=$_[0]; 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); 166 } 167 return %rv; 168} 169 170#decodes any NTLMSSP packet. 171#arg: the encoded packet, returns an hash with packet info 172sub decode_ntlm_any { 173 my($got)=$_[0]; 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 181} 182 183 184use integer; 185 186sub encode_base64 ($;$) 187{ 188 my $res = ""; 189 my $eol = $_[1]; 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); 194 chop($res); 195 } 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 201 if (length $eol) { 202 $res =~ s/(.{1,76})/$1$eol/g; 203 } 204 $res; 205} 206 207 208sub decode_base64 ($) 209{ 210 local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123] 211 212 my $str = shift; 213 my $res = ""; 214 215 $str =~ tr|A-Za-z0-9+=/||cd; # remove non-base64 chars 216 if (length($str) % 4) { 217 require Carp; 218 Carp::carp("Length of base64 data not a multiple of 4") 219 } 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 225 } 226 $res; 227} 228