Fix checksum generation so that it actually works with clients.
[sitka/SIPServer.git] / Sip / Checksum.pm
CommitLineData
d19d5be0 1#
2# Copyright (C) 2006-2008 Georgia Public Library Service
3#
4# Author: David J. Fiander
5#
6# This program is free software; you can redistribute it and/or
7# modify it under the terms of version 2 of the GNU General Public
8# License as published by the Free Software Foundation.
9#
10# This program is distributed in the hope that it will be useful,
11# but WITHOUT ANY WARRANTY; without even the implied warranty of
12# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13# GNU General Public License for more details.
14#
15# You should have received a copy of the GNU General Public
16# License along with this program; if not, write to the Free
17# Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
18# MA 02111-1307 USA
19
20package Sip::Checksum;
21
22use Exporter;
23use strict;
24use warnings;
b4803216 25use integer; # important
d19d5be0 26
ba1da199 27our $VERSION = 0.02;
d19d5be0 28our @EXPORT_OK = qw(checksum verify_cksum);
ba1da199 29our @ISA = qw(Exporter);
b4803216
JA
30our $debug = 0;
31
32sub debug_print {
33 my $label = shift;
34 my $var = shift;
35 printf STDERR "# %16s: %016s %4.4s %6s\n",
36 $label,
37 substr(sprintf("%b", $var), -16),
38 uc substr(sprintf("%4.4x",$var), -4),
39 $var;
40}
41
42sub debug_split_print {
43 my $line = shift;
44 my $total = 0;
45 my (@row, @rows);
46 foreach(split('', $line)) {
47 $total += ord($_);
48 push @row, $_;
49 if (scalar(@row) == 10) {
50 push @rows, [@row];
51 @row = ();
52 }
53 }
54 scalar(@row) and push @rows, \@row;
55 foreach (@rows) {
56 my $subtotal = 0;
57 print map {" $_ "} @$_;
58 printf "\n%-50s", join '', map {sprintf " %3d ", $_} map {$subtotal += ord($_); ord($_)} @$_;
59 printf "= %4d\n\n", $subtotal;
60 }
61 printf "%56d\n", $total;
62 return $total;
63}
64
d19d5be0 65
66sub checksum {
b4803216 67 my $pkt = shift;
b4803216 68 my $u = unpack('%U*', $pkt);
52a025ea 69 my $check = ($u * -1) & 0xFFFF;
b4803216 70 return $check;
d19d5be0 71}
72
73sub verify_cksum {
74 my $pkt = shift;
75 my $cksum;
76 my $shortsum;
77
3e634a08 78 return 0 if (not defined($pkt) or substr($pkt, -6, 2) ne "AZ"); # No checksum at end
d19d5be0 79
80 # Convert the checksum back to hex and calculate the sum of the
81 # pack without the checksum.
82 $cksum = hex(substr($pkt, -4));
83 $shortsum = unpack("%16C*", substr($pkt, 0, -4));
84
85 # The checksum is valid if the hex sum, plus the checksum of the
86 # base packet short when truncated to 16 bits.
87 return (($cksum + $shortsum) & 0xFFFF) == 0;
88}
89
29ae5acf
JA
901;
91
d19d5be0 92__END__
93
94#
95# Some simple test data
96#
97sub test {
98 my $testpkt = shift;
99 my $cksum = checksum($testpkt);
100 my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);
101
102 print $fullpkt, "\n";
103}
104
105while (<>) {
106 chomp;
107 test($_);
108}