helpers/ntlm_auth/fake/ntlm_fake_auth.pl.in

   1 #!@PERL@
   2 #
   3 # (C) 2000 Francesco Chemolli <kinkie@kame.usr.dsi.unimi.it>
   4 # Distributed freely under the terms of the GNU General Public License,
   5 # version 2. For the licensing terms, see the file COPYING that
   6 # came with Squid.
   7 #
   8 # This is a dummy NTLM authentication module for Squid.
   9 # It performs the NTLM challenge, but then it doesn't verify the
  10 # user's credentials, it just takes the client's domain and username
  11 # at face value.
  12 # It's included mostly for demonstration purposes.
  13 #
  14 # TODO: use command-line arguments
  15
  16 #use MIME::Base64;
  17
  18 $|=1;
  19 #$authdomain="your_domain_goes_here";
  20 $challenge="deadbeef";
  21
  22 $authdomain=$ARGV[0] if ($#ARGV >=0);
  23
  24 die ("Edit $0 to configure a domain!") unless (defined($authdomain));
  25
  26 while(<STDIN>) {
  27         chop;
  28         if (substr($_, 0, 2) eq "YR") {
  29                 print "TT ".encode_base64(&make_ntlm_static_challenge);
  30                 next;
  31         }
  32         $got=substr($_,3);
  33         %res=decode_ntlm_any(decode_base64($got));
  34 #       print STDERR "got: ".hash_to_string(%res);
  35         if (!res) {                                                                             # broken NTLM, deny
  36                 print "BH Couldn't decode NTLM packet\n";
  37                 next;
  38         }
  39         if ($res{type} eq "negotiate") { # ok, send a challenge
  40                 print "BH Squid-helper protocol error: unexpected negotiate-request\n";
  41                 next;
  42         }
  43         if ($res{type} eq "challenge") { # Huh? WE are the challengers.
  44                 print "BH Squid-helper protocol error: unexpected challenge-request\n";
  45                 next;
  46         }
  47         if ($res{type} eq "authentication") {
  48                 print "AF $res{domain}\\$res{user}\n";
  49                 next;
  50         }
  51         print "BH internal error\n";    # internal error
  52 }
  53
  54
  55 sub make_ntlm_static_challenge {
  56         $rv = pack ("a8 V", "NTLMSSP", 0x2);
  57         $payload = "";
  58
  59         $rv .= add_to_data(uc($authdomain),\$payload);
  60         $rv .= pack ("V Z8 v8", 0x18206, $challenge,0,0,0,0,0,0,0x3a,0);
  61         #flags, challenge, 8 bytes of unknown stuff
  62
  63         return $rv.$payload;
  64 }
  65
  66 #gets as argument the decoded authenticate packet.
  67 #returns either undef (failure to decode) or an hash with the decoded
  68 # fields.
  69 sub decode_ntlm_authentication {
  70         my ($got)=$_[0];
  71         my ($signature, $type, %rv, $hdr, $rest);
  72         ($signature, $type, $rest) = unpack ("a8 V a*",$got);
  73         return unless ($signature eq "NTLMSSP\0");
  74         return unless ($type == 0x3);
  75         $rv{type}="authentication";
  76         ($hdr, $rest) = unpack ("a8 a*", $rest);
  77         $rv{lmresponse}=get_from_data($hdr,$got);
  78         ($hdr, $rest) = unpack ("a8 a*", $rest);
  79         $rv{ntresponse}=get_from_data($hdr,$got);
  80         ($hdr, $rest) = unpack ("a8 a*", $rest);
  81         $rv{domain}=get_from_data($hdr,$got);
  82         ($hdr, $rest) = unpack ("a8 a*", $rest);
  83         $rv{user}=get_from_data($hdr,$got);
  84         ($hdr, $rest) = unpack ("a8 a*", $rest);
  85         $rv{workstation}=get_from_data($hdr,$got);
  86         ($hdr, $rest) = unpack ("a8 a*", $rest);
  87         $rv{sessionkey}=get_from_data($hdr,$got);
  88         $rv{flags}=unpack("V",$rest);
  89         return %rv;
  90 }
  91
  92 #args: len, maxlen, offset
  93 sub make_ntlm_hdr {
  94         return pack ("v v V", @_);
  95 }
  96
  97 #args: string to add, ref to payload
  98 # returns ntlm header.
  99 sub add_to_data {
 100         my ($toadd, $pl) = @_;
 101         my ($offset);
 102 #       $toadd.='\0' unless ($toadd[-1]=='\0'); #broken
 103         $offset=48+length $pl;  #48 is the length of the header
 104         $$pl.=$toadd;
 105         return make_ntlm_hdr (length $toadd, length $toadd, $offset);
 106 }
 107
 108 #args: encoded descriptor, entire decoded packet
 109 # returns the decoded data
 110 sub get_from_data {
 111         my($desc,$packet) = @_;
 112         my($offset,$length, $rv);
 113         ($length, undef, $offset) = unpack ("v v V", $desc);
 114         return unless ($length+$offset <= length $packet);
 115         $rv = unpack ("x$offset a$length",$packet);
 116         return $rv;
 117 }
 118
 119 sub hash_to_string {
 120         my (%hash) = @_;
 121         my ($rv);
 122         foreach (sort keys %hash) {
 123                 $rv.=$_." => ".$hash{$_}."\n";
 124         }
 125         return $rv;
 126 }
 127
 128
 129 #more decoder functions, added more for debugging purposes
 130 #than for any real use in the application.
 131 #args: the base64-decoded packet
 132 #returns: either undef or an hash describing the packet.
 133 sub decode_ntlm_negotiate {
 134         my($got)=$_[0];
 135         my($signature, $type, %rv, $hdr, $rest);
 136         ($signature, $type, $rest) = unpack ("a8 V a*",$got);
 137         return unless ($signature eq "NTLMSSP\0");
 138         return unless ($type == 0x1);
 139         $rv{type}="negotiate";
 140         ($rv{flags}, $rest)=unpack("V a*",$rest);
 141         ($hdr, $rest) = unpack ("a8 a*", $rest);
 142         $rv{domain}=get_from_data($hdr,$got);
 143         ($hdr, $rest) = unpack ("a8 a*", $rest);
 144         $rv{workstation}=get_from_data($hdr,$got);
 145         return %rv;
 146 }
 147
 148 sub decode_ntlm_challenge {
 149         my($got)=$_[0];
 150         my($signature, $type, %rv, $hdr, $rest, $j);
 151         ($signature, $type, $rest) = unpack ("a8 V a*",$got);
 152         return unless ($signature eq "NTLMSSP\0");
 153         return unless ($type == 0x2);
 154         $rv{type}="challenge";
 155         ($rv{flags}, $rest)=unpack("V a*",$rest);
 156         ($rv{challenge}, $rest)=unpack("a8 a*",$rest);
 157         for ($j=0;$j<8;$j++) {                          # don't shoot on the programmer, please.
 158                 ($rv{"context.$j"},$rest)=unpack("v a*",$rest);
 159         }
 160         return %rv;
 161 }
 162
 163 #decodes any NTLMSSP packet.
 164 #arg: the encoded packet, returns an hash with packet info
 165 sub decode_ntlm_any {
 166         my($got)=$_[0];
 167         my ($signature, $type);
 168         ($signature, $type, undef) = unpack ("a8 V a*",$got);
 169         return unless ($signature eq "NTLMSSP\0");
 170         return decode_ntlm_negotiate($got) if ($type == 1);
 171         return decode_ntlm_challenge($got) if ($type == 2);
 172         return decode_ntlm_authentication($got) if ($type == 3);
 173         return undef;                                                                   # default
 174 }
 175
 176
 177 use integer;
 178
 179 sub encode_base64 ($;$)
 180 {
 181     my $res = "";
 182     my $eol = $_[1];
 183     $eol = "\n" unless defined $eol;
 184     pos($_[0]) = 0;                          # ensure start at the beginning
 185     while ($_[0] =~ /(.{1,45})/gs) {
 186         $res .= substr(pack('u', $1), 1);
 187         chop($res);
 188     }
 189     $res =~ tr|` -_|AA-Za-z0-9+/|;               # `# help emacs
 190     # fix padding at the end
 191     my $padding = (3 - length($_[0]) % 3) % 3;
 192     $res =~ s/.{$padding}$/'=' x $padding/e if $padding;
 193     # break encoded string into lines of no more than 76 characters each
 194     if (length $eol) {
 195         $res =~ s/(.{1,76})/$1$eol/g;
 196     }
 197     $res;
 198 }
 199
 200
 201 sub decode_base64 ($)
 202 {
 203     local($^W) = 0; # unpack("u",...) gives bogus warning in 5.00[123]
 204
 205     my $str = shift;
 206     my $res = "";
 207
 208     $str =~ tr|A-Za-z0-9+=/||cd;            # remove non-base64 chars
 209     if (length($str) % 4) {
 210         require Carp;
 211         Carp::carp("Length of base64 data not a multiple of 4")
 212     }
 213     $str =~ s/=+$//;                        # remove padding
 214     $str =~ tr|A-Za-z0-9+/| -_|;            # convert to uuencoded format
 215     while ($str =~ /(.{1,60})/gs) {
 216         my $len = chr(32 + length($1)*3/4); # compute length byte
 217         $res .= unpack("u", $len . $1 );    # uudecode
 218     }
 219     $res;
 220 }