#!/usr/bin/perl
#
# netbios.pl
# PERL functions implementing Microsoft protocols.
# by Sam Kline, 5/01
# added routines for win_login.saint, Sam Kline, 6/01
# changes for Windows updates checks, Sam Kline, 3/02
#
# Copyright (C) 2001, World Wide Digital Security, Inc.
# All rights reserved.

use Socket;

sub netbios_init {

# User ID
$uid1 = 0;
$uid2 = 0;

# Tree ID
$tid1 = 0;
$tid2 = 0;

# File ID
$fid1 = 0;
$fid2 = 0;

# other data
$save_data1 = "";
$save_data2 = "";
$remote_os = "";
$remote_auth = "";
}

sub open_socket {

my($server, $proto, $port) = @_;
my(%type) = ('tcp' => SOCK_STREAM,
	     'udp' => SOCK_DGRAM);

$port_addr = sockaddr_in($port, inet_aton($server))
	|| die "cannot resolve target";
$protocol = getprotobyname($proto);
socket(SOCK, PF_INET, $type{$proto}, $protocol)
	|| die "cannot create socket";
if ($proto eq "tcp") {
    connect(SOCK, $port_addr);
}
}

sub close_socket {

close(SOCK);
}

sub netbios_name_request {

my($target) = @_;
my($nb_name);

@send=();
# Transaction ID
push @send, "0x2b", "0x6d";
# Flags
push @send, 0,0;
# Question count
push @send, 0,1;
# Answer count
push @send, 0,0;
# Name service count
push @send, 0,0;
# Additonal record count
push @send, 0,0;
# Netbios name 
push @send, 32,67,75,(65)x30,0;
# record type = netbios node status resource record
push @send, 0, 33;
# record class = internet class
push @send, 0,1;
$send = &create_string(@send);
$i = 57;
$nb_name = "";
while(!$nb_name) {
  send(SOCK,$send,0,sockaddr_in(137,inet_aton($target))) || die "cannot send";
  recv(SOCK,$recv,$i+18,0);
  if (ord(substr($recv,$i+15,1)) == 0 &&
      ord(substr($recv,$i+16,1)) < 128 &&
      ord(substr($recv,$i+17,1)) == 0) {
    ($nb_name=substr($recv,$i,15)) =~ s/\s+$//;
    $nb_name = "" if $nb_name =~ /^IS~/;
  } else {
    sleep 1;
  }
  $i+=18;
}
return $nb_name;
}

sub session_request {

my($name) = @_;

@send=();
# Type 0x81 session request
&netbios_header("0x81");
# Data
push @send, &encode_name($name), 0;
push @send, &encode_name(""), 0;
$send = &create_string(@send);
return 0 if !&send_and_receive ($send, "^\\130");
return 1;
}

sub session_negotiate {

my($ntlm) = @_;

@send = ();
# Type 0 session request
&netbios_header(0);
# Command = negotiate
&smb_header("0x72");
# parameter word 0
push @send, 0;
# SMB negotiate request
@data = ();
push @data, 2,"PC NETWORK PROGRAM 1.0",0;
push @data, 2,"MICROSOFT NETWORKS 1.03",0;
push @data, 2,"MICROSOFT NETWORKS 3.0",0;
push @data, 2,"LANMAN1.0",0;
push @data, 2,"LM1.2X002",0;
push @data, 2,"Samba",0;
if ($ntlm =~ /ntlm/i) {
  push @data, 2,"NT LANMAN 1.0",0;
  push @data, 2,"NT LM 0.12",0;
}
$data = &create_string(@data);
push @send, length($data), 0, $data;
$send = &create_string(@send);

return 0 if ! &send_and_receive ($send, "r\\000\\000\\000");
return 1;
}

sub session_setup {

my($nbname,$login,$password,$ntlm) = @_;
@send = ();
@data = ();
# Type 0 session message
&netbios_header(0);
# session setup
&smb_header("0x73");
# Parameter word count
if ($ntlm =~ /ntlm/i) {
  push @send, 13;
} else {
  push @send, 10;
}
# Command
push @send,255;
# Stuff
push @send, 0,0,0;
# Maximum buffer size = 1041
push @send, 4,17;
# Maximum multiplexed request = 12800
push @send, 2,0;
# ANSI Password Length
push @send, (0)x6, length($password) + 1, 0;
# UNICODE Password Length
push @send, 0,0;
# Flags
push @send, 0,0;
if ($ntlm =~ /ntlm/i) {
  push @send, (0)x6;
  # Data
  push @data, $login,0,$password,0,$nbname, 0, "Unix", 0, "Samba", 0;
} else {
  # Login+Password size
  push @send, length($login) + length($password) + 2,0;
  # Password+Login
  push @send, $password,0,$login,0;
  # Data
  push @data, $nbname, 0, "Unix", 0, "Samba", 0;
}
$data = &create_string(@data);
# Data byte count
push @send, length($data),0;
push @send, $data;
$send = &create_string(@send);
return 0 if !&send_and_receive($send, "s\\000\\000\\000");
$uid1 = ord(substr($data,28,1));
$uid2 = ord(substr($data,29,1));
if ($ntlm =~ /ntlm/i) {
  ($remote_os, $remote_auth) =
	(substr($data,41) =~ /^([\w .-]+)\0([\w .-]+)\0/);
}
return 1;
}

sub tree_connect {

my($name) = @_;

@send = ();
# Type 0 session message
&netbios_header(0);
# command
&smb_header("0x75");
# Parameter word count
push @send, 4;
# Command = 0x75
push @send,255;
# Stuff
push @send, 0,0,0,0,0,1;
# Data byte count
push @send, 0,length($name)+13;
# Data
push @send, 0,0;
push @send, "\\\\$name\\IPC\$",0,"IPC",0;
$send = &create_string(@send);
return 0 if !&send_and_receive($send, "u\\000\\000\\000");
$tid1 = ord(substr($data,24,1));
$tid2 = ord(substr($data,25,1));
return 1;
}

sub nt_create() {

my($pipe) = @_;

@send=();
# Type 0 session request
&netbios_header(0);
# command = Create File
&smb_header("0xa2");
# Parameter word count
push @send, 24;
# secondary command
push @send, 255;
# Stuff
push @send, 0,0,0,0;
# Name Length
push @send, 7,0;
# Flags
push @send, 6,0,0,0;
# Root Directory FID
push @send, (0)x4;
# Access desired
push @send, 159,1;
# Allocation size
push @send, 2,0,0,0;
# Type
push @send, 0,0,0,0;
# Share Access
push @send, 0,0,0,0;
# Action if file exists
push @send, 0,0,3,0;
# Option if creating file
push @send, 0,0,1,0;
# Security QOS information
push @send, 0,0,0,0;
# Data byte count
push @send, 0,0,2;
# Data
push @send, 0,0,0,0,8,0;
push @send, $pipe,0;

$send = &create_string(@send);
return 0 if (! &send_and_receive ($send, "\\162\\000\\000\\000\\000"));
$fid1 = ord(substr($data,38,1));
$fid2 = ord(substr($data,39,1));
return 1;
}

sub nt_close {

@send = ();
# Type 0 Netbios session
&netbios_header(0);
# command = close
&smb_header(4);
push @send, 3,$fid1,$fid2,255,255,255,255,0,0;
$send = &create_string(@send);
return 0 if !&send_and_receive($send, "\\004\\000\\000\\000\\000");
$save_data2 = substr($data,60,8);
return 1;
}

sub bind_pipe {

my($pipe) = @_;

@data = ();
# Major
push @data, 5;
# Minor
push @data, 0;
# Packet type
push @data, 11;
# Flag
push @data, 0;
# Packet type
push @data, 16,0,0,0;
# Fragment length (will be filled in later)
push @data, 0,0;
# Auth Length
push @data, 0,0;
# Call ID
push @data,1,0,0,0;
# Maximum transmission fragment size
push @data, 48,22;
# Maximum receive fragment size
push @data, 48,22;
# Associated group ID
push @data, 0,0,0,0;
# Number of elements
push @data, 1,0,0,0;
# Context ID
push @data,0,0;
# Number of syntaxes
push @data,1;
# Stuff
push @data,0;
# version of interface client:
if ($pipe eq "\\winreg") {
  # time - low
  push @data, 1,208,140,51;
  # time - mid
  push @data, 68,34,241,49;
  # time - hi and version
  push @data, 170,170,144,0;
  # remaining
  push @data, 56,0,16,3,1,0,0,0;
} elsif ($pipe eq "\\lsarpc") {
  # time - low
  push @data, 120,87,52,18;
  # time - mid
  push @data, 52,18,205,171;
  # time - hi and version
  push @data, 239,0,1,35;
  # remaining
  push @data, 69,103,137,171,0,0,0,0;
}
# version to use for replies:
# time - low
push @data, 4,93,136,138;
# time - mid
push @data, 235,28,201,17;
# time - hi and version
push @data, 159,232,8,0;
# remaining
push @data, 43,16,72,96,2,0,0,0;
return 0 if !&transaction(&create_string(@data));
return 1;
}

sub open_hklm {

@data = &open(2,20,2);
push @data,1,0,0,0;
push @data, 224,132,0,0;
push @data, 0,0,0,2;
return 0 if !&transaction(&create_string(@data));
$save_data1 = substr($data, 84, 8);
$last_cmd = "open hklm";
return 1;
}

sub init_read {

my($size) = @_;

@send = ();
# Type 0 Netbios session
&netbios_header(0);
# command = read and X
&smb_header(0x2e);
# parameter word count
push @send, 10;
# stuff
push @send, 255,0,0,0;
# File ID
push @send, $fid1, $fid2;
# Offset
push @send, 0,0,0,0;
# Size
push @send,$size,0;
# Size
push @send,$size,0;
# stuff
push @send, (0)x8;

$send = &create_string(@send);
return 0 if !&send_and_receive($send, ".\\000\\000\\000\\000");
if ($last_cmd eq "open hklm") {
    $save_data2 = substr($data,60,8);
} elsif ($last_cmd eq "lsa query") {
    $offset = length($data) - 28;
    $sid_rev = substr($data,$offset,1);
    $offset += 2;
    $id_auth = substr($data,$offset,6);
    $offset += 6;
    $sub_auth = substr($data,$offset,16);
} elsif ($last_cmd eq "lookup sid") {
    # check that return status is zero
    return 0 if substr($data,length($data)-4,4) ne "\0\0\0\0";
    # To get offset, round netbios name length up to
    # nearest multiple of 2 and double
    $offset = 2 * (($nb_name_len+1) & 254) + 64;
    $length = ord(substr($data,$offset,1));
    $offset += 24;
    if ($length > 0) {
	($login_name = substr($data,$offset,$length)) =~ s/\0//g;
    } else {
	return 0;
    }
}
return 1;
}

sub open_reg_entry {

my($key) = @_;

@data = &open(3,72,15);
# Data
push @data, 0,0,0,0,$save_data1,$save_data2;
# Unicode string length
push @data, 2*(length($key)+1),0;
# Unicode maximum length
push @data, 2*(length($key)+1),0;
# Buffer
push @data, 1,0,0,0;
# Unicode maximum length
push @data, length($key)+1,0,0,0;
# Stuff
push @data, 0,0,0,0;
# Unicode string length
push @data, length($key)+1,0,0,0;
# Data
push @data, &unicode("$key"),0,0;
push @data, 0,0 if length($key) % 2 == 0;
# Stuff
push @data, (0)x7,2;
return 0 if !&transaction(&create_string(@data));
return 1 if ord(substr($data,100,1)) == 0;
return 0;
}

sub open {

my($cid,$hint,$op) = @_;
my(@data) = ();
# Major
push @data, 5;
# Minor
push @data, 0;
# packet type
push @data, 0;
# flags
push @data,3;
# packet type
push @data, 16,0,0,0;
# fragment length (filled in later)
push @data, 0,0;
# auth length
push @data, 0,0;
# call ID
push @data, $cid,0,0,0;
# alloc hint
push @data, $hint,0,0,0;
# context ID
push @data, 0,0;
# op num
push @data, $op,0;

return @data;
}

sub lookup_sid {

my($account_id) = @_;
my($account_id1, $account_id2);

$account_id1 = $account_id % 256;
$account_id2 = int($account_id / 256);

@data = &open(8,92,15);
push @data, 0,0,0,0;
push @data, $save_data1;
# number entries
push @data, 1,0,0,0;
# SID pointer
push @data, 1,0,0,0;
# number entries
push @data, 1,0,0,0;
# SID pointer
push @data, 1,0,0,0;
# number auths
push @data, 5,0,0,0;
# SID rev number, number auths
push @data, $sid_rev,5;
# auth ID
push @data, $id_auth;
# sub auth
push @data, $sub_auth,$account_id1,$account_id2,0,0;
push @data, (0)x8,1,0,0,0,16,177,255,239;
return 0 if !&transaction(&create_string(@data));
$nb_name_len = ord(substr($data,120));
$last_cmd = "lookup sid";
return 1;
}

sub lsa_open {

@data = &open(2,44,6);
push @data, 1,0,0,0;
# System name
push @data, 92,0,0,0;
# Length
push @data, 24,0,0,0;
# root directory, object name, attribute pointers
push @data,(0)x20;
# access
push @data,1,0,0,0;
return 0 if !&transaction(&create_string(@data));
$save_data1 = substr($data,84,16);
return 1;
}

sub lsa_open_sec {

@data = &open(7,52,6);
push @data, 1,0,0,0;
# System name
push @data, 92,0,0,0;
# Length
push @data, 24,0,0,0;
# root directory, object name, attribute pointers
push @data,(0)x16,1,0,0,0;
# length
push @data,12,0,0,0;
# stuff
push @data,2,0,1,0,0,0,0,32;
return 0 if !&transaction(&create_string(@data));
$save_data1 = substr($data,84,16);
return 1;
}

sub lsa_query {

my($call_id, $info_class) = @_;;

@data = &open($call_id,30,7);
push @data, 0,0,0,0;
push @data, $save_data1;
# info class
push @data, $info_class,0;
return 0 if !&transaction(&create_string(@data));
$last_cmd = "lsa query";
return 1;
}

sub lsa_close {

@data = &open(5,28,0);
push @data, 0,0,0,0;
push @data, $save_data1;
return 0 if !&transaction(&create_string(@data));
$last_cmd = "lsa close";
return 1;
}

sub transaction {

my($data) = @_;
$data_len = length($data);
substr($data, 8, 1, chr($data_len));

@send = ();
# Type 0 session request
&netbios_header(0);
# command = transaction
&smb_header("0x25");
# parameter word count
push @send, 16;
# total parameter being sent
push @send, 0,0;
# total bytes being sent
push @send, $data_len,0;
# maximum parameter bytes to return
push @send, 0,0;
# maximum data bytes to return
push @send, $data_len,0;
# maximum setup words to return
push @send, 0;
# flags
push @send, 0,0,0;
# transaction timeout
push @send, (0)x4;
# parameter sent this buffer
push @send, (0)x4;
# parameter offset
push @send, 76,0;
# data sent this buffer
push @send, $data_len,0;
# data offset
push @send, 76,0;
# setup words
push @send, 2,0;
# code = 0x26 (Read/Write)
push @send, "0x26",0;
# File ID
push @send, $fid1, $fid2;
# Data length
push @send, $data_len+9,0;
# file name
push @send, "\\PIPE\\", 0,0,0;
# Data
push @send, $data;

$send = &create_string(@send);
return 0 if !&send_and_receive ($send, "%\\000\\000\\000", "%\\001\\000\\234");
return 1;
}

sub netbios_header {

my($type) = @_;

$type = &hex2dec($type) if $type =~ /^0x\w\w$/;
# Type 0 session request
push @send, $type;
# Flags
push @send, 0;
# Packet length (will be filled in later)
push @send, 0,0;
}

sub smb_header {

my($command) = @_;

$command = &hex2dec($command) if $command =~ /^0x\w\w$/;
# other stuff
push @send, 255, "SMB";
# command
push @send, $command;
# no errors
push @send, 0,0,0,0;
# flags
push @send, 8,1,0;
# other stuff
push @send, (0)x12;
# Tree ID
push @send, $tid1, $tid2;
# Process ID
push @send, 10,14;
# User ID
push @send, $uid1, $uid2;
# Multiplex ID
push @send, 1,0;
}

sub unicode {

my($in) = @_;
my($out);

$out = join chr(0), (split //, $in);
$out .= chr(0);
return $out;
}

sub encode_name {

my($name) = @_;
my($encoded, $c, $i);

$encoded = " ";
$i = 0;

while ($i < 16) {
    if ($i < length($name)) {
	$c = substr($name,$i,1);
	$encoded .= chr(int((ord $c)/16) + ord 'A');
	$encoded .= chr((ord $c)%16 + ord 'A');
    } else {
	$encoded .= "CA";
    }
    $i++;
}

return $encoded;
}

sub create_string {

my($send_string);
my(@send_list) = @_;

for $val (@send_list) {

  if ($val =~ /^\d+$/) {
    $val = chr($val);
  }
  elsif ($val =~ /^0x\w\w$/) {
    $val = chr(&hex2dec($val));
  }
}
$send_string = join '', @send_list;
return $send_string;
}

sub hex2dec {

my($in) = @_;
my(@hex);

$hex[0] = substr($in,2,1);
$hex[1] = substr($in,3,1);

for $digit (@hex) {
    $digit = ord($digit)-ord('A')+10 if $digit =~ /[A-F]/;
    $digit = ord($digit)-ord('a')+10 if $digit =~ /[a-f]/;
}
return(16*$hex[0] + $hex[1]);
}

sub send_and_receive {

my($in,@out) = @_;
my($head,$send_len,$send_len_hi,$send_len_lo,$recv_len);
my(@recv_list);

$send_len = length($in)-4;
$send_len_hi = int($send_len/256);
$send_len_lo = $send_len%256;
substr($in, 2, 2, chr($send_len_hi) . chr($send_len_lo));
#print "Sending:\n";
#for ($i=0; $i<$send_len+4; $i+=8) {
#  for ($j=0; $j<8 && $i+$j < $send_len+4; $j++) {
#    $k = substr($in, $i+$j, 1);
#    if (ord($k) < 32 || ord($k) > 126) {
#        print ".";
#    } else {
#        print $k;
#    }
#  }
#  print " ";
#  for ($j=0; $j<8 && $i+$j < $send_len+4; $j++) {
#    $k = substr($in, $i+$j, 1);
#    print ord($k) . "-";
#  }
#  print "\n";
#}
syswrite (SOCK, $in, length($in));
sysread (SOCK, $head, 4);
$recv_len = ord(substr($head,2,1))*256 + ord(substr($head,3,1));
sysread (SOCK, $data, $recv_len);
#print "Received:\n";
#for ($i=0; $i<$recv_len; $i+=8) {
#  for ($j=0; $j<8 && $i+$j < $recv_len; $j++) {
#    $k = substr($data, $i+$j, 1);
#    if (ord($k) < 32 || ord($k) > 126) {
#        print ".";
#    } else {
#        print $k;
#    }
#  }
#  print " ";
#  for ($j=0; $j<8 && $i+$j < $recv_len+4; $j++) {
#    $k = substr($data, $i+$j, 1);
#    print ord($k) . "-";
#  }
#  print "\n";
#}
@recv_list = split //, $head . $data;
for (@recv_list) {
        $o = ord($_);
        $_ = sprintf "\\%03d", $o if ($o<32 || $o>126);
}
$recv_string = join '', @recv_list;
for (@out) {
	s/([^\w\^])/\\$1/g;
	return 1 if $recv_string =~ /$_/;
}
return 0;
}
1;
