1#!/usr/bin/perl 2# $Id$ 3# view PKT contents 4# (c) Husky development team 5# This script reads PKT from stdin and prints it's contents in human-readabe form into stdout 6# options: 7# -v verbose 8# -s print SEEN-BY, PATH and PTH kludges 9# -r print RFC-* kludges 10# -p print PID and TID kludges 11# -h print usage information 12 13# This program is free software; you can redistribute it and/or modify 14# it under the terms of the GNU General Public License as published by 15# the Free Software Foundation; either version 2 of the License, or 16# (at your option) any later version. 17# 18# This program is distributed in the hope that it will be useful, 19# but WITHOUT ANY WARRANTY; without even the implied warranty of 20# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21# GNU General Public License for more details. 22 23 24sub usage{ 25my @Id = split(/ /,'$Id$'); 26my $programid="$Id[1] $Id[2]"; 27undef @Id; 28 29print <<US; 30 $programid - View PKT contents (c) Husky development team 31 This script reads PKT from stdin and prints it's contents in human-readabe form into stdout 32 options: 33 -v verbose 34 -s print SEEN-BY, PATH and PTH kludges 35 -r print RFC-* kludges 36 -p print PID and TID kludges 37 -h print usage information (this screen) 38US 39} 40 41sub getattr($) { 42 my($attr)=@_; 43 my(@attr); 44 push @attr,'Pvt' if($attr&0x0001); 45 push @attr,'Cra' if($attr&0x0002); 46 push @attr,'Rcd' if($attr&0x0004); 47 push @attr,'Snt' if($attr&0x0008); 48 push @attr,'Att' if($attr&0x0010); 49 push @attr,'Trs' if($attr&0x0020); 50 push @attr,'Orp' if($attr&0x0040); 51 push @attr,'K/s' if($attr&0x0080); 52 push @attr,'Loc' if($attr&0x0100); 53 push @attr,'Hld' if($attr&0x0200); 54 push @attr,'???' if($attr&0x0400); 55 push @attr,'Req' if($attr&0x0800); 56 push @attr,'RRq' if($attr&0x1000); 57 push @attr,'RRd' if($attr&0x2000); 58 push @attr,'Aud' if($attr&0x4000); 59 push @attr,'Upd' if($attr&0x8000); 60 return @attr; 61} 62$verbose=0; 63$noseenby=1; 64$norfc=1; 65$nopid=1; 66foreach(@ARGV) { 67 if(/^-.*h/){ &usage; exit; } 68 $verbose=1 if(/^-.*v/); 69 $noseenby=0 if(/^-.*s/); 70 $norfc=0 if(/^-.*r/); 71 $nopid=0 if(/^-.*p/); 72} 73while(1) { 74 die "Broken packet - invalid header size.\n" 75 if(read(STDIN,$pkthdr,0x3a) != 0x3a); 76 ($origNode,$destNode,$year,$month,$day,$hour,$minute,$seconds, 77 $baud,$type,$origNet,$destNet, 78 # Follows Type2+ packet fields... 79 $ProductCode,$RevMaj,$Password,$QMOrigZone,$QMDestZone,$AuxNet,$CapValidate, 80 $PCodeHi,$RevMin,$Cap,$origZone,$destZone,$origPoint,$destPoint,$appdata)= 81 unpack('S2S3S3 S2S2 C2A8S2S2 C2SS4I',$pkthdr); 82 # print "QMOrigZone:$QMOrigZone, QMDestZone:$QMDestZone,AuxNet:$AuxNet\n"; 83 die "Unknown packet header type $type!\n" if($type != 2); 84 if($Cap == 0x0001 && $CapValidate == 0x0100 ) { 85 print "Version:2+\n"; 86 printf "From: %u:%u/%u.%u\t\t%2u/%2u/%2u %2u:%2u:%2u\n", 87 $origZone, $origNet, $origNode, $origPoint, $day+1, $month+1, $year, $hour,$minute,$seconds; 88 print "To : $destZone:$destNet/$destNode.$destPoint\n"; 89 print "Prodcode : ",$ProductCode+$PCodeHi*256," ($RevMaj.$RevMin)\n"; 90 print "Password : `$Password'\n"; 91 } else { 92 print "Version:2\n"; 93 printf "From: %u/%u\t\t%2u/%2u/%2u %2u:%2u:%2u\n", 94 $origNet, $origNode, $day, $month, $year, $hour,$minute,$seconds; 95 print "To : $destNet/$destNode\n"; 96 print "Prodcode : $ProductCode\n"; 97 print "[ May be 2+ $origZone:$origNet/$origNode.$origPoint -> $destZone:$destNet/$destNode.$destPoint ]\n"; 98 } 99 $div="-----------------------------------------------------------------------------\n"; 100 print $div; 101 while(read(STDIN,$version,2)==2&&($pktver=unpack('S',$version))==2) { 102 die "Broken packet - invalid message header" 103 if(read(STDIN,$hdr,12)!=12); 104 ($origNode,$destNode,$origNet,$destNet,$attr,$cost)=unpack('S6',$hdr); 105 $/="\0"; 106 $dateTime=<STDIN>; 107 chop $dateTime; 108 $ToName=<STDIN>; 109 chop $ToName; 110 $FromName=<STDIN>; 111 chop $FromName; 112 $Subj=<STDIN>; 113 chop $Subj; 114 $Text=<STDIN>; 115 chop $Text; 116 $/="\n"; 117 if(length($dateTime)>19|| 118 length($ToName)>35|| 119 length($FromName)>35|| 120 length($Subj)>71) { 121 print "Warning: Bad field(s) length (too long)\n"; 122 } 123 $Text=~s/\r\n?/\n/gs; 124 $Text.="\n" unless($Text=~/\n$/s); 125 undef $area; 126 if($Text=~/^AREA:\s*(\S+)\n/m) { 127 undef $area if(($area=$1) eq 'NETMAIL'); 128 substr($Text,length($`),length($&))='' unless ($verbose); 129 } 130 if($area) { 131 undef $origAddr; 132 undef $destAddr; 133 } else { 134 $origAddr="$origNet/$origNode"; 135 $destAddr="$destNet/$destNode"; 136 if($Text=~/^\x01INTL:?[ ]+(\d+:\d+\/\d+)[ ]+(\d+:\d+\/\d+)[ ]*\n/m) { 137 $destAddr=$1; 138 $origAddr=$2; 139 substr($Text,length($`),length($&))='' unless ($verbose); 140 } 141 if($Text=~/^\x01FMPT:?[ ]+(\d+)[ ]*\n/m) { 142 $origAddr.=".$1"; 143 substr($Text,length($`),length($&))='' unless ($verbose); 144 } 145 if($Text=~/^\x01TOPT:?[ ]+(\d+)[ ]*\n/m) { 146 $destAddr.=".$1"; 147 substr($Text,length($`),length($&))='' unless ($verbose); 148 } 149 } 150 if(!$origAddr && 151 $Text=~/^ \* Origin:[^\(\n]*\([^0-9\n\)]*(\d+:\d+\/\d+(\.\d+)?)(\@[^\)\n]+)?\)\n/m) { 152 # (\@[^\)\n])?\)\n/m) { 153 $origAddr=$1; 154 } 155 undef $msgid_addr,$msgid_crc; 156 if($Text=~/^\x01MSGID:[ ]*(\S+)[ ]+([0-9a-fA-F]{1,8})[ ]*\n/m) { 157 $pos=length($`); 158 $len=length($&); 159 $msgid_addr=$1; 160 $msgid_crc=hex("0x$2"); 161 # print "Found MSGID:$1|$2|$&|\n"; 162 if($msgid_addr=~m|^(\d+:)?\d+/\d+(\.\d+)?(\@.*$)?|) { 163 $domain=$3; 164 $ldomain=length($domain); 165 substr($msgid_addr,-$ldomain,$ldomain)='' 166 if($domain=~/^\@fidonet(\.org)?$/); 167 } else { 168 $msgid_addr.="($origAddr)" if($origAddr); 169 } 170 $origAddr=$msgid_addr; 171 substr($Text,$pos,$len)='' unless($verbose); 172 } 173 if($noseenby) { 174 $Text=~s/^SEEN-BY:[^\n]*\n//mg; 175 $Text=~s/^\x01PATH:[^\n]*\n//mg; 176 $Text=~s/^\x01PTH:[^\n]*\n//mg; 177 } 178 if($norfc) { 179 $Text=~s/^\x01RFC-[^\n]*\n//mg; 180 } 181 if($nopid) { 182 $Text=~s/^\x01PID:[^\n]*\n//mg; 183 $Text=~s/^\x01TID:[^\n]*\n//mg; 184 } 185 $Text=~s/^\x01/\@/gm; 186 print "From: $FromName, $origAddr\t$dateTime\n"; 187 if($area) { 188 print "To : $ToName\n"; 189 } else { 190 print "To : $ToName, $destAddr\n"; 191 } 192 print "Subj: $Subj\n"; 193 if($verbose) { 194 $attr_str=sprintf("0x%04x-",$attr); 195 } else { 196 $attr_str=''; 197 } 198 $attr_str.=join(' ',getattr($attr)); 199 $div_attr=$div; 200 substr($div_attr,2,length($attr_str))=$attr_str; 201 substr($div_attr,-5-length($area),length($area)+2)="\[$area\]"; 202 print $div_attr; 203 print $Text; 204 print $div; 205 } 206 if($pktversion==0) { 207 print "-------========================Packet Done normally===================-------\n"; 208 exit 0 if(eof(STDIN)); 209 } else { 210 print "-------===========================Broken packet=======================-------\n"; 211 exit 1; 212 } 213}; 214__END__ 215