#!/usr/bin/perl

########################################################################
# This script deletes the annoying "Spam Mail" folder                  #
# ("Approved Sender List") on an Exchange server                       #
#                                                                      #
#              !!! USE AT YOUR VERY OWN RISK !!!                       #
#                                                                      #
# (c) 2006, Felix J. Ogris, DTS Service GmbH                           #
# licensed under GPLv2                                                 #
########################################################################

### Module
use IO::Socket;
use MIME::Base64;
use Authen::Perl::NTLM;

### Variablen
$HOST = $ENV{"EXHOST"};
$DOM = $ENV{"EXDOM"};
$USER = $ENV{"EXUSER"};
$PASS = $ENV{"EXPASS"};

$SPAM = "Spam%20Mail";
$MUELLEIMER = "Deleted%20Items";

### Dummer User
die "\nPlease provide your Exchange credentials through environment variables" .
    ", eg.\nEXHOST='127.0.0.2' EXDOM='DTSSERVICE' EXUSER='PMEIER' EXPASS='geheim' $0\n\n"
  if (!$HOST || !$DOM || !$USER || !$PASS);

### Verbindung aufbauen
$s = new IO::Socket::INET(PeerAddr => $HOST, PeerPort => 80,
                          Proto => "tcp") || die "$!";

### Hash erzeugen
$lm_hash = Authen::Perl::NTLM::lm_hash($PASS);
$nt_hash = Authen::Perl::NTLM::nt_hash($PASS);

$flags = Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_128 |
    #     Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_NTLM2 |
         Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_ALWAYS_SIGN |
         Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_NTLM |
         Authen::Perl::NTLM::NTLMSSP_REQUEST_TARGET |
         Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_OEM |
         Authen::Perl::NTLM::NTLMSSP_NEGOTIATE_UNICODE;

$client = new_client Authen::Perl::NTLM($lm_hash, $nt_hash, $USER, "", "", "");
$nego = encode_base64($client->negotiate_msg($flags), "");

### Step 1: Authentifizierung anfordern
print $s <<EOF;
GET /exchange/ HTTP/1.1
Host: $HOST
Authorization: NTLM $nego
Connection: Keep-Alive

EOF

($proto, $code, $hint) = split(/\s+/, <$s>, 3);
die "unexpected HTTP code: $code $hint" if ($code ne "401");

while (<$s>) {
  $cookie = $1 if /^set-cookie:\s+([^\;]+)/i;
  $len = $1 if /^content-length:\s+(\d+)/i;
  $chall = $1 if /^www-authenticate:\s+ntlm\s+(.+)/i;
  last if /^\s*$/;
}

read($s, $tmp, $len) if $len;
die "no challenge" if !$chall;

### Nonce ermitteln
($target, $flags, $nonce, $ctx_lower, $ctx_upper) =
  $client->parse_challenge(decode_base64($chall));
$auth = encode_base64($client->auth_msg($nonce, $flags), "");

### Step 2: Authentifizieren
print $s <<EOF;
GET /exchange/ HTTP/1.1
Host: $HOST
Authorization: NTLM $auth
Connection: Keep-Alive

EOF

($proto, $code, $hint) = split(/\s+/, <$s>, 3);
die "unexpected HTTP code: $code $hint" if ($code ne "200");

while (<$s>) {
  $cookie = $1 if /^set-cookie:\s+([^\;]+)/i;
  $len = $1 if /^content-length:\s+(\d+)/i;
  last if /^\s*$/;
}

read($s, $tmp, $len) if $len;
die "no cookie" if !$cookie;

### Ordner verschieben
print $s <<EOF;
MOVE /exchange/$USER/$SPAM/ HTTP/1.1
Host: $HOST
Connection: Keep-Alive
Cookie: $cookie
Destination: /exchange/$USER/$MUELLEIMER/$SPAM/

EOF

($proto, $code, $hint) = split(/\s+/, <$s>, 3);
die "unexpected HTTP code: $code $hint" if ($code ne "201");

while (<$s>) {
  $len = $1 if /^content-length:\s+(\d+)/i;
  last if /^\s*$/;
}

read($s, $tmp, $len);

### Ordner löschen
$xml = "<?xml version=\"1.0\"?><D:delete xmlns:D=\"DAV:\"><D:target><D:href>";
$xml .= "$SPAM</D:href></D:target></D:delete>";
$len = length($xml) + 1;

print $s <<EOF;
BDELETE /exchange/$USER/$MUELLEIMER/ HTTP/1.1
Host: $HOST
Connection: Keep-Alive
Cookie: $cookie
Content-Length: $len
Content-Type: text/xml; charset="utf-8"

$xml
EOF

($proto, $code, $hint) = split(/\s+/, <$s>, 3);
die "unexpected HTTP code: $code $hint" if ($code ne "207");

while (<$s>) {
  $len = $1 if /^content-length:\s+(\d+)/i;
  last if /^\s*$/;
}

read($s, $tmp, $len);

### Ende
close($s);