From 4b33a95f3772a82a89c2cd61966b7650d81ea011 Mon Sep 17 00:00:00 2001
From: Joe Atzberger <atz@esilibrary.com>
Date: Mon, 24 May 2010 22:52:21 +0000
Subject: [PATCH] Checksum computation overhaul

This adds advanced debugging of checksum computation.

Note: good sample data is lacking.  I think most of the actual
checksum lines included in the test are questionable.  The only
one that computes accurately seems to be the example from the
3M SIP Developers Guide that specifically addresses checksum
computation.  The others from the same guide seem invalid!

I think the debugging output suggests the implementation is
consistent with the specified instructions, despite unavailability
of sample data to confirm.
---
 Sip/Checksum.pm   | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
 t/0001_checksum.t | 37 +++++++++++++++++++++++++++++++++++++
 2 files changed, 89 insertions(+), 2 deletions(-)
 create mode 100755 t/0001_checksum.t

diff --git a/Sip/Checksum.pm b/Sip/Checksum.pm
index 4a91c3d..da3fbaa 100644
--- a/Sip/Checksum.pm
+++ b/Sip/Checksum.pm
@@ -22,13 +22,63 @@ package Sip::Checksum;
 use Exporter;
 use strict;
 use warnings;
+use integer;    # important
 
 our @ISA = qw(Exporter);
 our @EXPORT_OK = qw(checksum verify_cksum);
+our $debug = 0;
+
+sub debug_print {
+    my $label = shift;
+    my $var   = shift;
+    printf STDERR "# %16s: %016s %4.4s %6s\n",
+        $label,
+           substr(sprintf("%b",   $var), -16),
+        uc substr(sprintf("%4.4x",$var),  -4),
+        $var;
+}
+
+sub debug_split_print {
+    my $line = shift;
+    my $total = 0;
+    my (@row, @rows);
+    foreach(split('', $line)) {
+        $total += ord($_);
+        push @row, $_;
+        if (scalar(@row) == 10) {
+            push @rows, [@row];
+            @row = ();
+        }
+    }
+    scalar(@row) and push @rows, \@row;
+    foreach (@rows) {
+        my $subtotal = 0;
+        print map {"   $_ "} @$_;
+        printf "\n%-50s", join '', map {sprintf " %3d ", $_} map {$subtotal += ord($_); ord($_)} @$_;
+        printf "= %4d\n\n", $subtotal;
+    }
+    printf "%56d\n", $total;
+    return $total;
+}
+
 
 sub checksum {
-    my $pkt = shift;
-    return (-unpack('%16C*', $pkt) & 0xFFFF);
+    my $pkt   = shift;
+    # my $u   = unpack('%16U*', $pkt);
+    my $u     = unpack('%U*', $pkt);
+    my $check = uc substr sprintf("%x", ~$u+1), -4;
+    if ($debug) {
+        my $total = debug_split_print($pkt);
+        $total == $u or warn "Internal error: mismatch between $total and $u";
+        printf STDERR "# checksum('$pkt')\n# %34s  HEX  DECIMAL\n", 'BINARY';
+        debug_print("ascii sum",      $u  );
+        debug_print("binary invert", ~$u  );
+        debug_print("add one",       ~$u+1);
+        printf STDERR "# %39s\n", $check;
+    }
+
+    return $check;
+    # return (-unpack('%16U*', $pkt) & 0xFFFF);
 }
 
 sub verify_cksum {
diff --git a/t/0001_checksum.t b/t/0001_checksum.t
new file mode 100755
index 0000000..923981c
--- /dev/null
+++ b/t/0001_checksum.t
@@ -0,0 +1,37 @@
+#!/usr/bin/perl
+#
+# Copyright: 2010 - Equinox Software, Inc.
+#    Author: Joe Atzberger
+#   License: GPLv2 or later
+
+use strict;
+use warnings;
+use Test::More tests => 5;
+
+use vars qw/ $debug /;
+
+BEGIN {
+    use_ok('Sip::Checksum', qw/checksum verify_cksum/);
+    $debug = @ARGV ? shift  : 0;
+    $Sip::Checksum::debug = $debug;
+}
+
+note("checksum: " . checksum("9300CNLoginUserID|COLoginPassword|CPLocationCode|AY5AZEC78"));
+
+my %pairs = (
+    FCB4 => '990 402.00AY1AZ',  # see page 26 of the 3M SIP2 Developers Guide
+    EC78 => '9300CNLoginUserID|COLoginPassword|CPLocationCode|AY5AZ',
+    F400 => '2300119960212 100239AOid_21|104000000105|AC|AD|AY2AZ',
+    CBC8 => '18030001200808050000053612CF 0|AB2030527770|AJWalter in the woods and the letter W / by Cynthia Klingel and Robert B. Noyed.|BG|BV|CK000|AQreerd|CH|AF|CSE KLINGEL | CT|AY9AZ',
+    CD15 => '101YNN2008050000053612AOkcls |AB2030527770|AQreerd|AJWalter in the woods and the letter W / by Cynthia Klingel and Robert B. Noyed.|AF|CSE KLINGEL|CRreerd|AY89AZ',
+    DC06 => '101YNN200808050000053558AOkcls |AB2029693658|AQrecfc|AJClementine and Mungo / by Saray Dyer.|AF|CSE DYER|CRrecfc|AY1AZ'
+);
+
+foreach (sort keys %pairs) {
+    my $string = $pairs{$_};
+    my $checksum = checksum($string);
+    is($checksum, $_, "checksum($string)");
+    ok(verify_cksum("$string$_"), "verify_cksum($string$_)");
+}
+# is();
+1;
-- 
2.11.0