Koha/C4/SIP/Sip/Checksum.pm
Ulrich Kleiber 8a7c916766 Bug 6765: sip2 unicode checksum
Changes checksum calculation method, as per Dan Scott's fix in openncip.
see http://sourceforge.net/tracker/?func=detail&aid=2925760&group_id=161781&atid=821216

http://bugs.koha-community.org/show_bug.cgi?id=6765
Signed-off-by: Ian Walls <ian.walls@bywatersolutions.com>
Signed-off-by: Chris Cormack <chrisc@catalyst.net.nz>
2011-08-27 19:38:32 +12:00

64 lines
1.2 KiB
Perl

package Sip::Checksum;
use Exporter;
use strict;
use warnings;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(checksum verify_cksum);
our $debug = 0;
sub checksum {
my $pkt = shift;
return (-unpack('%16C*', $pkt) & 0xFFFF);
}
sub verify_cksum {
my $pkt = shift;
my $cksum;
my $shortsum;
if ($pkt =~ /AZ(....)$/) {
$debug and warn "verify_cksum: sum ($1) detected";
} else {
warn "verify_cksum: no sum detected";
return 0; # No checksum at end
}
# return 0 if (substr($pkt, -6, 2) ne "AZ");
# Convert the checksum back to hex and calculate the sum of the
# pack without the checksum.
$cksum = hex($1);
$shortsum = unpack("%16C*", substr($pkt, 0, -4));
# The checksum is valid if the hex sum, plus the checksum of the
# base packet short when truncated to 16 bits.
return (($cksum + $shortsum) & 0xFFFF) == 0;
}
{
no warnings qw(once);
eval join('',<main::DATA>) || die $@ unless caller();
# FIXME: what the heck is this?
}
1;
__END__
#
# Some simple test data
#
sub test {
my $testpkt = shift;
my $cksum = checksum($testpkt);
my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);
print $fullpkt, "\n";
}
while (<>) {
chomp;
test($_);
}
1;