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 @ISA = qw(Exporter);
  28 our @EXPORT_OK = qw(checksum verify_cksum);
  29 our $debug = 0;
  30
  31 sub debug_print {
  32     my $label = shift;
  33     my $var   = shift;
  34     printf STDERR "# %16s: %016s %4.4s %6s\n",
  35         $label,
  36            substr(sprintf("%b",   $var), -16),
  37         uc substr(sprintf("%4.4x",$var),  -4),
  38         $var;
  39 }
  40
  41 sub debug_split_print {
  42     my $line = shift;
  43     my $total = 0;
  44     my (@row, @rows);
  45     foreach(split('', $line)) {
  46         $total += ord($_);
  47         push @row, $_;
  48         if (scalar(@row) == 10) {
  49             push @rows, [@row];
  50             @row = ();
  51         }
  52     }
  53     scalar(@row) and push @rows, \@row;
  54     foreach (@rows) {
  55         my $subtotal = 0;
  56         print map {"   $_ "} @$_;
  57         printf "\n%-50s", join '', map {sprintf " %3d ", $_} map {$subtotal += ord($_); ord($_)} @$_;
  58         printf "= %4d\n\n", $subtotal;
  59     }
  60     printf "%56d\n", $total;
  61     return $total;
  62 }
  63
  64
  65 sub checksum {
  66     my $pkt   = shift;
  67     # my $u   = unpack('%16U*', $pkt);
  68     my $u     = unpack('%U*', $pkt);
  69     my $check = uc substr sprintf("%x", ~$u+1), -4;
  70     if ($debug) {
  71         my $total = debug_split_print($pkt);
  72         $total == $u or warn "Internal error: mismatch between $total and $u";
  73         printf STDERR "# checksum('$pkt')\n# %34s  HEX  DECIMAL\n", 'BINARY';
  74         debug_print("ascii sum",      $u  );
  75         debug_print("binary invert", ~$u  );
  76         debug_print("add one",       ~$u+1);
  77         printf STDERR "# %39s\n", $check;
  78     }
  79
  80     return $check;
  81     # return (-unpack('%16U*', $pkt) & 0xFFFF);
  82 }
  83
  84 sub verify_cksum {
  85     my $pkt = shift;
  86     my $cksum;
  87     my $shortsum;
  88
  89     return 0 if (not defined($pkt) or substr($pkt, -6, 2) ne "AZ"); # No checksum at end
  90
  91     # Convert the checksum back to hex and calculate the sum of the
  92     # pack without the checksum.
  93     $cksum = hex(substr($pkt, -4));
  94     $shortsum = unpack("%16C*", substr($pkt, 0, -4));
  95
  96     # The checksum is valid if the hex sum, plus the checksum of the
  97     # base packet short when truncated to 16 bits.
  98     return (($cksum + $shortsum) & 0xFFFF) == 0;
  99 }
 100
 101 1;
 102
 103 __END__
 104
 105 #
 106 # Some simple test data
 107 #
 108 sub test {
 109     my $testpkt = shift;
 110     my $cksum = checksum($testpkt);
 111     my $fullpkt = sprintf("%s%4X", $testpkt, $cksum);
 112
 113     print $fullpkt, "\n";
 114 }
 115
 116 while (<>) {
 117     chomp;
 118     test($_);
 119 }