helpers/ntlm_auth/no_check/no_check.pl

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