Created snf4sa.pm.windows that should run on Windows.

git-svn-id: https://svn.microneil.com/svn/PKG-SNF-CS-NIX/trunk@116 233e721a-07f6-49eb-a7da-05e0e16828fc

SNF_CS_Developer_Package/SNF4SA/INSTALL

@@ -14,11 +14,14 @@ following steps:
   to meet your needs.  See below for a description of the
   configuration settings.
 
-The module writes the email message to a temporary file in
-/tmp/snf4sa.  If this directory doesn't exist, the script creates it
-with permission 777.  This allows both the script and SNFServer to
-write to that directory.  If that directory already exists, ensure
-that it has a permission of 777.
+The module writes the email message to a temporary file in /tmp/snf4sa
+(C:\TEMP\SNF4SA for Windows).  If this directory doesn't exist, the
+script creates it with permission 777.  This allows both the script
+and SNFServer to write to that directory.  If that directory already
+exists, ensure that it has a permission of 777.
+
+Windows users: Install the file snf4sa.pm.windows, renaming it to
+snf4sa.pm in the installation directory.
 
 The plugin uses the SNFServer results to calculate a plugin score.
 For SpamAssassin with a version of 3.2.0 or later, this plugin score

SNF_CS_Developer_Package/SNF4SA/snf4sa.pm.windows

@@ -0,0 +1,775 @@
+#
+# SpamAssassin SNF4SA Plugin for SNFServer.
+#
+# This plugin implements a SpamAssassin rule to use SNFServer to test
+# whether an email is spam.
+#
+# Copyright (C) 2009 ARM Research Labs, LLC.
+#
+# snf4sa.pm
+#
+# The plugin implements a single evaluation rule, which passes the
+# email message through SNFServer.  The communication with SNFServer
+# is through XCI and a temporary file on disk which contains the email
+# message truncated to the frist 64K bytes.
+#
+
+package Snf4sa;
+use strict;
+use Mail::SpamAssassin;
+use Mail::SpamAssassin::Plugin;
+use Mail::SpamAssassin::PerMsgStatus;
+use Mail::SpamAssassin::Logger;
+use IO::Socket;
+use IO::File;
+
+use File::Temp qw/ tempfile tempdir /;
+our @ISA = qw(Mail::SpamAssassin::Plugin);
+
+# Convenience variables and pseudo-constants
+my $CRLF                   = "\x0d\x0a";
+
+# translation table for SNF rule codes
+my $rule_code_xlat = {
+    0  => 'Standard White Rules',
+    20 => 'GBUdb Truncate (superblack)',
+    40 => 'GBUdb Caution (suspicious)',
+    47 => 'Travel',
+    48 => 'Insurance',
+    49 => 'Antivirus Push',
+    50 => 'Media Theft',
+    51 => 'Spamware',
+    52 => 'Snake Oil',
+    53 => 'Scam Patterns',
+    54 => 'Porn/Adult',
+    55 => 'Malware & Scumware Greetings',
+    56 => 'Ink & Toner',
+    57 => 'Get Rich',
+    58 => 'Debt & Credit',
+    59 => 'Casinos & Gambling',
+    60 => 'Ungrouped Black Rules',
+    61 => 'Experimental Abstract',
+    62 => 'Obfuscation Techniques',
+    63 => 'Experimental Received [ip]',
+};
+
+sub new {
+  my ($class, $mailsa) = @_;
+  $class = ref($class) || $class;
+  my $self = $class->SUPER::new($mailsa);
+  bless ($self, $class);
+
+  # Name of evaluation rule.
+  $self->register_eval_rule ("snf4sa_sacheck");
+
+  # Use localhost.
+  $self->{SNF_Host} = "localhost";
+
+  # Use default port.
+  $self->{SNF_Port} = 9001;
+
+  # Timeout.
+  $self->{SNF_Timeout} = 1;
+
+  # Directory for files containing emails read by SNFServer.
+  $self->{Temp_Dir} = 'C:\\TEMP\\SNF4SA';
+
+  # Maximum email message size (including headers).
+  $self->{SNF_MaxTempFileSize} = 64 * 1024;
+
+  # Key for confidence in mail header inserted by SNFServer.
+  $self->{GBUdb_ConfidenceKey} = "c=";
+
+  # Key for probability in mail header inserted by SNFServer.
+  $self->{GBUdb_ProbabilityKey} = "p=";
+
+  # Key for GBUdb maximum weight in the configuration file.
+  $self->{GBUdb_MaxWeightKey} = "gbudb_max_weight";
+
+  # Key for SNFServer code in configuration file.
+  $self->{SNF_CodeKey} = "snf_result";
+
+  # Key for SA score increment in configuration file.
+  $self->{SA_DeltaScoreKey} = "sa_score";
+
+  # Key for short circuit in configuration file.
+  $self->{SA_ShortCircuitYesKey} = "short_circuit_yes";
+
+  # Key for no short circuit in configuration file.
+  $self->{SA_ShortCircuitNoKey} = "short_circuit_no";
+
+  # Key for plugin score threshold in the configuration file.
+  $self->{Plugin_score_thresholdKey} = "pre_3.2_plugin_score_threshold";
+
+  return $self;
+}
+
+# DEBUG/TEST.
+#sub extract_metadata {
+#
+# my ($self, $opts) = @_;
+#
+# print "***********************\n";
+# print "extract_metadata called\n";
+# print "***********************\n";
+#
+# $opts->{msg}->put_metadata("X-Extract-Metadata:", "Test header");
+#
+#}
+# END OF DEBUG/TEST.
+
+sub have_shortcircuited {
+
+    my ($self, $options) = @_;
+
+    if (defined($options->{permsgstatus}->{shortCircuit})) {
+
+        return $options->{permsgstatus}->{shortCircuit};
+
+    }
+    return 0;
+}
+
+sub parse_config {
+
+    my ($self, $options) = @_;
+
+    # DEBUG.
+    #print "parse_confg.  key:  $options->{key}\n";
+    #print "parse_config.  line:  $options->{line}\n";
+    #print "parse_config.  value:  $options->{value}\n";
+    #END OF DEBUG.
+
+    # Process GBUdb_max_weight.
+    if (lc($options->{key}) eq $self->{GBUdb_MaxWeightKey}) {
+
+        # GBUdb maximum weight.
+        my $tempValue = $options->{value};
+        # Test that the value was a number.
+        #$self->log_debug("Found $self->{GBUdb_MaxWeightKey} . " value:  $options->{value}, tempValue:  $tempValue\n"; # DEBUG.
+
+        if ($tempValue =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
+
+            # Value was a number.  Load and return success.
+            $options->{conf}->{gbuDbMaxWeight} = $tempValue;
+            $self->inhibit_further_callbacks();
+            return 1;
+
+        } else {
+
+            $self->log_debug("Invalid value for $self->{GBUdb_MaxWeightKey} " .
+                             $tempValue);
+
+        }
+    } elsif (lc($options->{key}) eq $self->{Plugin_score_thresholdKey}) {
+
+        # Plugin score threshold.
+        my $tempValue = $options->{value};
+        # Test that the value was a number.
+        #print "Found $self->{Plugin_score_thresholdKey} value:  $options->{value}\n"; # DEBUG.
+
+        if ($tempValue =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) {
+
+            # Value was a number.  Load and return success.
+            $options->{conf}->{pluginScoreThreshold} = $tempValue;
+            $self->inhibit_further_callbacks();
+            return 1;
+
+        } else {
+
+            $self->log_debug("Invalid value for $self->{Plugin_score_thresholdKey} " .
+                             $tempValue);
+
+        }
+    } elsif (lc($options->{key}) eq $self->{SNF_CodeKey}) {
+
+        # Relationship between SNFServer code and SA score delta.
+        my $snf = $self->parse_snf_sa_mapping($options);
+        if (defined($snf)) {
+            my @snfCode = @{$snf->{snfCode}};
+            #print "snf->{snfCode}:  @snfCode\n"; # DEBUG.
+            #print "snf->{deltaScore}:  $snf->{deltaScore}\n"; # DEBUG.
+            #print "snf->{shortCircuit}:  $snf->{shortCircuit}\n"; # DEBUG.
+
+            # Save configuration.
+            foreach my $i (@{$snf->{snfCode}}) {
+
+                # Create (or update) an element in the mapping array
+                # that snfSaMapping is a reference to.
+                $options->{conf}->{snfSaMapping}->[$i] = {
+                    deltaScore => $snf->{deltaScore},
+                    shortCircuit => $snf->{shortCircuit}
+                };
+
+            }
+
+            # DEBUG.
+            #for (my $i = 0; $i < @{$options->{conf}->{snfSaMapping}}; $i++) {
+            #    if (! defined($options->{conf}->{snfSaMapping}->[$i])) {
+            #        print "No configuration for SNFServer code $i\n";
+            #        next;
+            #    }
+            #    print "SNFServer code:  $i, " .
+            #        "deltaScore:  " .
+            #        "$options->{conf}->{snfSaMapping}->[$i]->{deltaScore}, " .
+            #        "shortCircuit:  " .
+            #        "$options->{conf}->{snfSaMapping}->[$i]->{shortCircuit}\n";
+            #}
+            # END OF DEBUG.
+
+            # Successfully parsed.
+            $self->inhibit_further_callbacks();
+            return 1;
+        }
+    }
+
+    # Wasn't handled.
+    return 0;
+
+}
+
+# Parse a snf_result configuration line.
+#
+# Input--
+#
+#   $line--String containing the snf_result line without the first word.
+#
+# Returns a reference with the following fields (if no error)--
+#
+#   snfCode--Array of SNFServer result codes that this configuration
+#   line specifies.
+#
+#   deltaScore--SA score increment for the codes in @snfCode.
+#
+#   shortCircuit--True if a SNFServer code in @snfCode is to
+#   short-circuit the message scan, false otherwise.
+#
+# If the line cannot be parsed, the return value is undef.
+#
+sub parse_snf_sa_mapping
+{
+    my ($self, $options) = @_;
+
+    my $value = $options->{value};
+
+    my $ret_hash = {
+        snfCode      => undef,
+        deltaScore   => undef,
+        shortCircuit => undef
+    };
+
+    # SNFServer codes found.
+    my @snfCode = ();
+
+    # Remove leading and trailing whitespace.
+    $value =~ s/^\s+//;
+    $value =~ s/\s+$//;
+
+    # Convert to lower case.
+    $value = lc($value);
+
+    # Split up by white space.
+    my @specVal = split(/\s+/, $value);
+
+    if (0 == @specVal) {
+
+        # No separate words.
+        $self->log_debug("No separate words found in configuration line '" .
+                         $options->{line} . "'");
+        return undef;
+
+    }
+
+    # Convert each SNFServer result specification into an integer.
+    my $lastSpec;
+    for ($lastSpec = 0; $lastSpec < @specVal; $lastSpec++) {
+
+        # Check for next keyword.
+        if ($specVal[$lastSpec] eq $self->{SA_DeltaScoreKey}) {
+
+            # We've completed the processing of the SNFServer result
+            # codes.
+            last;
+
+        }
+
+        # Get the code values.
+        my @codeVal = $self->get_code_values($specVal[$lastSpec]);
+        if (0 == @codeVal) {
+
+            # No code values were obtained.
+            $self->log_debug("Couldn't parse all the SNFServer code values " .
+                             "in configuration line '" .
+                             $options->{line} . "'");
+            return undef;
+
+        }
+
+        # Add to the list of codes.
+        @snfCode = (@snfCode, @codeVal);
+
+    }
+
+    # Sort the SNFServer result codes and remove duplicates.
+    @snfCode = sort { $a <=> $b } @snfCode;
+    my $prev = -1;
+    my @temp = grep($_ != $prev && (($prev) = $_), @snfCode);
+    $ret_hash->{snfCode} = \@temp;
+
+    # The $specVal[$lastSpec] is $self->{SA_DeltaScoreKey}.  Return if
+    # there aren't enough parameters.
+    $lastSpec++;
+    if ($lastSpec >= @specVal) {
+
+        # Not enough parameters.
+        $self->log_debug("Not enough parameters in configuration line '" .
+                         $options->{line} . "'");
+        return undef;
+
+    }
+
+    # Extract the SA delta score.
+    $ret_hash->{deltaScore} = $specVal[$lastSpec];
+    if (!($ret_hash->{deltaScore} =~
+          /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/)) {
+
+        # SA delta score isn't a number.
+        $self->log_debug("Value after '" . $self->{SA_DeltaScoreKey} .
+                         "' ($specVal[$lastSpec]) must be a number " .
+                         "in configuration line '" .
+                         $options->{line} . "'");
+        return undef;
+
+    }
+    
+    # Get short circuit spec.
+    $lastSpec++;
+    $ret_hash->{shortCircuit} = 0;
+    if ( ($lastSpec + 1) == @specVal) {
+
+        # A parameter was specified.
+        my $shortCircuitSpec = $specVal[$lastSpec];
+        if ($self->{SA_ShortCircuitYesKey} eq $shortCircuitSpec) {
+
+            # Specified short-circuit evaluation.
+            $ret_hash->{shortCircuit} = 1;
+
+        } elsif ($self->{SA_ShortCircuitNoKey} ne $shortCircuitSpec) {
+
+            # Invalid short-circuit specification.
+            $self->log_debug("Invalid short-circuit specification: '" .
+                             $specVal[$lastSpec] .
+                             "' in configuration line '" . $options->{line} .
+                             "'.  Must be '$self->{SA_ShortCircuitYesKey}' " .
+                             " or '$self->{SA_ShortCircuitNoKey}'.");
+            return undef;
+
+        }
+    } elsif ($lastSpec != @specVal) {
+
+        # Too many parameters were specified.
+        $self->log_debug("Too many parameters were specified in " .
+                         "configuration line '" . $options->{line} . "'");
+        return undef;
+
+    }
+        
+    return $ret_hash;
+
+}
+
+sub get_code_values
+{
+    my ($self, $specElement) = @_;
+
+    my @snfCode = ();
+
+    # Split the specification.
+    my @codeVal = split(/-/, $specElement);
+
+    if (1 == @codeVal) {
+
+        if ($specElement =~ /^\d+$/) {
+
+            # Found a single code.
+            $snfCode[0] = 1 * $specElement;
+
+        }
+
+    } elsif (2 == @codeVal) {
+
+        # Check range.
+        if ( ($codeVal[0] =~ /^\d+$/) && ($codeVal[1] =~ /^\d+$/) ) {
+
+            # Found a range of codes.
+            $codeVal[0] = 1 * $codeVal[0];
+            $codeVal[1] = 1 * $codeVal[1];
+            if ($codeVal[0] <= $codeVal[1]) {
+
+                # Add these SNF codes.
+                for (my $i = $codeVal[0]; $i <= $codeVal[1]; $i++) {
+
+                    push(@snfCode, $i);
+
+                }
+
+            }
+        }
+    }
+    return @snfCode;
+}
+
+# Output a debug message.
+#
+# Input--
+#
+#    $message--String containing the message to output.
+#
+sub log_debug
+{
+    my ($self, $message) = @_;
+    dbg("snf4sa: $message");
+}
+
+# Check the message with SNFServer.
+sub snf4sa_sacheck {
+
+ my ($self, $permsgstatus, $fulltext) = @_;
+
+ my $response ='';
+ my $exitvalue;
+
+ # Make sure we have a temp dir
+ unless(-d $self->{Temp_Dir}) {
+     mkdir($self->{Temp_Dir});
+     chmod(0777, $self->{Temp_Dir});
+ };
+
+ # Truncate the message.
+ my $mailtext = substr( ${$fulltext}, 0, $self->{SNF_MaxTempFileSize});
+
+ # create our temp file, $filename will contain the full path
+ my ($fh, $filename) = tempfile( DIR => $self->{Temp_Dir} );
+
+ # spew our mail into the temp file
+ my $SNF_fh = IO::File->new( $filename, "w" ) ||
+     die(__PACKAGE__ . ": Unable to create temporary file '" . $filename . "'");
+ $SNF_fh->print($mailtext) ||
+     $self->cleanup_die($filename,
+                 __PACKAGE__ . ": Unable to write to temporary file '" .
+                 $filename . "'");
+ $SNF_fh->close ||
+     $self->cleanup_die($filename,
+                 __PACKAGE__ . ": Unable to close temporary file '" .
+                 $filename . "'");
+
+ # Change permissions.
+ my $cnt = chmod(0666, $filename) ||
+     $self->cleanup_die($filename, __PACKAGE__ .
+                 ": Unable to change permissions of temporary file '" .
+                 $filename . "'");
+
+ # xci_scan connects to SNFServer with XCI to scan the message
+ my $SNF_XCI_Return = $self->xci_scan( $filename );
+
+ #print "header:\n\n$SNF_XCI_Return->{header}\n\n"; # DEBUG
+
+ # Remove the temp file, we are done with it.
+ unlink($filename);
+
+ # Check response from SNFServer.
+ if (! $SNF_XCI_Return ) {
+     die(__PACKAGE__ . ": Internal error");
+ }
+
+ # Check for success.
+ if (! $SNF_XCI_Return->{"success"}) {
+     die(__PACKAGE__ . ":  Error from SNFServer: " .
+         $SNF_XCI_Return->{"message"});
+ }
+
+ # get the return code and translation
+ my ( $rc, $rcx ) = ( $SNF_XCI_Return->{"code"},
+                      $rule_code_xlat->{ $SNF_XCI_Return->{"code"} } );
+
+ $rc = -1 unless defined $rc;    # default values
+ $rcx = 'Unknown' unless $rcx;
+ my $rch = $SNF_XCI_Return->{"header"}; # the SNF header(s)
+
+ # DEBUG.
+# for (my $i = 0; $i < @{$permsgstatus->{main}->{conf}->{snfSaMapping}}; $i++) {
+#     if (! defined($permsgstatus->{main}->{conf}->{snfSaMapping}->[$i])) {
+#	 print "No configuration for SNFServer code $i\n";
+#	 next;
+#     }
+#     print "SNFServer code:  $i, " .
+#	 "deltaScore:  " .
+#	 "$permsgstatus->{main}->{conf}->{snfSaMapping}->[$i]->{deltaScore}, " .
+#	 "shortCircuit:  " .
+#	 "$permsgstatus->{main}->{conf}->{snfSaMapping}->[$i]->{shortCircuit}\n";
+# }
+ # END OF DEBUG.
+
+ # Initialize the change in the SA score.
+ my $deltaScore = 0.0;
+
+ # Add the score from the SNFServer return.
+ if (defined($permsgstatus->{main}->{conf}->{snfSaMapping}->[$rc])) {
+
+     $deltaScore +=
+         $permsgstatus->{main}->{conf}->{snfSaMapping}->[$rc]->{deltaScore};
+     
+     $permsgstatus->{shortCircuit} = 
+         $permsgstatus->{main}->{conf}->{snfSaMapping}->[$rc]->{shortCircuit};
+
+ }
+
+ # Perform GBUdb processing.
+  if (defined($permsgstatus->{main}->{conf}->{gbuDbMaxWeight})) {
+
+      #print "gbudbMaxWeight:  $permsgstatus->{main}->{conf}->{gbuDbMaxWeight}\n\n"; # DEBUG.
+
+      # Calculate the contribution to the scrore from the GBUdb results.
+      $deltaScore +=
+          $self->calc_GBUdb($SNF_XCI_Return->{header},
+                            $permsgstatus->{main}->{conf}->{gbuDbMaxWeight});
+
+  }
+
+ # Add the headers.
+ $permsgstatus->set_tag("SNFRESULTTAG", "$rc ($rcx)");
+ $permsgstatus->set_tag("SNFMESSAGESNIFFERSCANRESULT",
+                        $self->extract_header_body($SNF_XCI_Return->{header},
+                                                   "X-MessageSniffer-Scan-Result"));
+ $permsgstatus->set_tag("SNFMESSAGESNIFFERRULES",
+                        $self->extract_header_body($SNF_XCI_Return->{header},
+                                                   "X-MessageSniffer-Rules"));
+ $permsgstatus->set_tag("SNFGBUDBANALYSIS",
+                        $self->extract_header_body($SNF_XCI_Return->{header},
+                                                   "X-GBUdb-Analysis"));
+
+ # If dynamic scoring isn't supported, this rule fires if the score is
+ # above the threshold.
+ if (Mail::SpamAssassin::Version() le "3.2.0") {
+     my $pluginScoreThreshold = 2.5; # Default value.
+     if (defined($permsgstatus->{main}->{conf}->{pluginScoreThreshold})) {
+	 $pluginScoreThreshold = $permsgstatus->{main}->{conf}->{pluginScoreThreshold};
+     }
+     #print "Before comparison.  pluginScoreThreshold:  $pluginScoreThreshold  deltaScore:  $deltaScore\n"; # DEBUG
+     if ($deltaScore < $pluginScoreThreshold) {
+	 $deltaScore = 0.0;
+     }
+ }
+# print "After comparison.  deltaScore:  $deltaScore\n"; # DEBUG
+
+ # Submit the score.
+ if ($deltaScore) {
+
+     $permsgstatus->got_hit("SNF4SA", "", score => $deltaScore);
+     for my $set (0..3) {
+         $permsgstatus->{conf}->{scoreset}->[$set]->{"SNF4SA"} =
+             sprintf("%0.3f", $deltaScore);
+     }
+
+ }
+
+ # Always return zero, since the score was submitted via got_hit()
+ # above.
+ return 0;
+
+}
+
+# Calculate the contribution of the GBUdb scan to the SA score.
+#
+# Input--
+#
+#   $headers--String containing the headers.
+#
+#   $weight--Weight used to calculate the contribution.
+#
+# Returns the contribution to the SA score (float).
+#
+sub calc_GBUdb
+{
+    my ( $self, $headers, $weight ) = @_;
+
+    # Split the header into lines.
+    my @headerLine = split(/\n/, $headers);
+
+    # Find the line containing the GBUdb results.
+    my $line;
+    foreach $line (@headerLine) {
+
+        # Search for the tag.
+        if ($line =~ /^X-GBUdb-Analysis:/) {
+
+            # GBUdb analysis was done.  Extract the values.
+            my $ind0 = index($line, $self->{GBUdb_ConfidenceKey});
+            my $ind1 = index($line, " ", $ind0 + 2);
+            if (-1 == $ind0) {
+
+                return 0.0;
+            }
+            my $c = 1.0 * substr($line, $ind0 + 2, $ind1 - $ind0 - 2);
+            #print "calc_GBUdb.  line:  $line\n"; # DEBUG
+            #print "calc_GBUdb.  c: $c, ind0: $ind0, ind1: $ind1\n"; # DEBUG
+            $ind0 = index($line, $self->{GBUdb_ProbabilityKey});
+            $ind1 = index($line, " ", $ind0 + 2);
+            if (-1 == $ind0) {
+
+                return 0.0;
+            }
+            my $p = 1.0 * substr($line, $ind0 + 2, $ind1 - $ind0 - 2);
+
+            #print "calc_GBUdb.  p: $p, ind0: $ind0, ind1: $ind1\n"; # DEBUG
+
+            # Calculate and return the score.
+            my $score = abs($p * $c) ** 0.5;
+            $score *=  $weight;
+            if ($p < 0.0) {
+                $score *= -1.0;
+            }
+	    # DEBUG.
+	    #print "calc_GBUdb.  p:  $p, c:  $c, weight:  $weight\n";
+            #print "calc_GBUdb.  score:  $score\n";
+	    # END OF DEBUG.
+            return $score;
+
+        }
+    }
+}
+
+# Extract the specified header body from a string containing all the
+# headers.
+#
+# Input--
+#
+#   $headers--String containing the headers.
+#
+#   $head--String containing the head of the header to extract.
+#
+# Returns the body of the header.
+#
+sub extract_header_body
+{
+    my ( $self, $headers, $head ) = @_;
+    my $body = "";
+    if ($headers =~ /$head:(.*)/s) {
+
+        my $temp = $1;
+        $temp =~ /(.*)\nX-(.*)/s;
+        $body = $1;
+
+    }
+    return $body;
+}
+
+# xci_scan( $file )
+# returns hashref:
+#   success : true/false
+#   code    : response code from SNF
+#   message : scalar message (if any)
+sub xci_scan
+{
+    my ( $self, $file ) = @_;
+    return undef unless $self and $file;
+
+    my $ret_hash = {
+        success => undef,
+        code    => undef,
+        message => undef,
+        header  => undef,
+        xml     => undef
+    };
+
+    my $xci = $self->connect_socket( $self->{SNF_Host}, $self->{SNF_Port} )
+      or return $self->err_hash("cannot connect to socket ($!)");
+
+    $xci->print("<snf><xci><scanner><scan file='$file' xhdr='yes' /></scanner></xci></snf>\n");
+    my $rc = $ret_hash->{xml} = $self->socket_response($xci, $file);
+    $xci->close;
+
+
+    if ( $rc =~ /^<snf><xci><scanner><result code='(\d*)'>/ ) {
+        $ret_hash->{success} = 1;
+        $ret_hash->{code}    = $1;
+        $rc =~ /<xhdr>(.*)<\/xhdr>/s and $ret_hash->{header} = $1;
+    } elsif ( $rc =~ /^<snf><xci><error message='(.*)'/ ) {
+        $ret_hash->{message} = $1;
+    } else {
+        $ret_hash->{message} = "unknown XCI response: $rc";
+    }
+
+    return $ret_hash;
+}
+
+# connect_socket( $host, $port )
+# returns IO::Socket handle
+sub connect_socket
+{
+    my ( $self, $host, $port ) = @_;
+    return undef unless $self and $host and $port;
+    my $protoname = 'tcp';    # Proto should default to tcp but it's not expensive to specify
+
+    $self->{XCI_Socket} = IO::Socket::INET->new(
+        PeerAddr => $host,
+        PeerPort => $port,
+        Proto    => $protoname,
+        Timeout  => $self->{SNF_Timeout} ) or return undef;
+
+    $self->{XCI_Socket}->autoflush(1);    # make sure autoflush is on -- legacy
+    return $self->{XCI_Socket};           # return the socket handle
+}
+
+# socket_response( $socket_handle )
+# returns scalar string
+sub socket_response
+{
+    my ( $self, $rs, $file ) = @_;
+    my $buf = '';    # buffer for response
+
+    # blocking timeout for servers who accept but don't answer
+    eval {
+        local $SIG{ALRM} = sub { die "timeout\n" };    # set up the interrupt
+        alarm $self->{SNF_Timeout};                    # set up the alarm
+
+        while (<$rs>) {                                # read the socket
+            $buf .= $_;
+        }
+
+        alarm 0;                                       # reset the alarm
+    };
+
+    # report a blocking timeout
+    if ( $@ eq "timeout\n" ) {
+        $self->cleanup_die($file,
+            __PACKAGE__ . ": Timeout waiting for response from SNFServer");
+    } elsif ( $@ =~ /alarm.*unimplemented/ ) {         # no signals on Win32
+        while (<$rs>) {                                # get whatever's left
+                                                       # in the socket.
+            $buf .= $_;
+        }
+    }
+    return $buf;
+}
+
+# return an error message for xci_scan
+sub err_hash
+{
+    my ( $self, $message ) = @_;
+
+    return {
+        success => undef,
+        code    => undef,
+        message => $message
+    };
+}
+
+sub cleanup_die
+{
+    my ( $self, $file, $message ) = @_;
+
+    unlink($file);
+    die($message);
+}
+1;