85b17a22c9fa1ddce06e68e058d62c2801f30e40
[sitka/SIPServer.git] / Sip / Checksum.pm
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
20 package Sip::Checksum;
21
22 use Exporter;
23 use strict;
24 use warnings;
25 use integer;    # important
26
27 our $VERSION   = 0.02;
28 our @EXPORT_OK = qw(checksum verify_cksum);
29 our @ISA   = qw(Exporter);
30 our $debug = 0;
31
32 sub 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
42 sub 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
65
66 sub checksum {
67     my $pkt   = shift;
68     # my $u   = unpack('%16U*', $pkt);
69     my $u     = unpack('%U*', $pkt);
70     my $check = uc substr sprintf("%x", ~$u+1), -4;
71     if ($debug) {
72         my $total = debug_split_print($pkt);
73         $total == $u or warn "Internal error: mismatch between $total and $u";
74         printf STDERR "# checksum('$pkt')\n# %34s  HEX  DECIMAL\n", 'BINARY';
75         debug_print("ascii sum",      $u  );
76         debug_print("binary invert", ~$u  );
77         debug_print("add one",       ~$u+1);
78         printf STDERR "# %39s\n", $check;
79     }
80
81     return $check;
82     # return (-unpack('%16U*', $pkt) & 0xFFFF);
83 }
84
85 sub verify_cksum {
86     my $pkt = shift;
87     my $cksum;
88     my $shortsum;
89
90     return 0 if (not defined($pkt) or substr($pkt, -6, 2) ne "AZ"); # No checksum at end
91
92     # Convert the checksum back to hex and calculate the sum of the
93     # pack without the checksum.
94     $cksum = hex(substr($pkt, -4));
95     $shortsum = unpack("%16C*", substr($pkt, 0, -4));
96
97     # The checksum is valid if the hex sum, plus the checksum of the 
98     # base packet short when truncated to 16 bits.
99     return (($cksum + $shortsum) & 0xFFFF) == 0;
100 }
101
102 1;
103
104 __END__
105
106 #
107 # Some simple test data
108 #
109 sub test {
110     my $testpkt = shift;
111     my $cksum = checksum($testpkt);
112     my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);
113
114     print $fullpkt, "\n";
115 }
116
117 while (<>) {
118     chomp;
119     test($_);
120 }