├── zebra.conf ├── drop-stats ├── info.txt ├── doit └── drop-stats ├── README ├── get-asn-names.pl ├── aslookup.pl ├── aggregate-by-asn.pl └── zebra-dump-parser.pl /zebra.conf: -------------------------------------------------------------------------------- 1 | ! To gather the data you need to add something like this to zebra.conf. 2 | 3 | ! all BGP packets: 4 | dump bgp all /var/spool/zebra/all.%Y%m%d.%H%M 6h 5 | ! routing table dumps: 6 | dump bgp routes-mrt /var/spool/zebra/dump.%Y%m%d.%H%M 6h 7 | -------------------------------------------------------------------------------- /drop-stats/info.txt: -------------------------------------------------------------------------------- 1 | A routing table snapshot is downloaded from the RIPE RIS archive. 2 | Each as-path of each route is processed and the last and second-last 3 | autonomous systems in the paths are recorded as the origin of the route 4 | and its "neighbor" networks (prepends are ignored). 5 | 6 | Beware: determining transit vs. peering vs. customer relationships is a 7 | non-trivial problem, so the last two tables may contain unexpected results. 8 | 9 | Networks are considered "evil" if they only announce listed networks. 10 | If they also announce non-listed networks, they are merely "bad". 11 | 12 | The first table only considers networks announced by the AS being 13 | considered, networks announced by downstream ASes are not counted there. 14 | 15 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | This program parses a dump of BGP routes in the zebra/MRT format. 2 | 3 | If you do not want to collect your own BGP dumps then a popular source 4 | for them is the RIPE RIS service, e.g.: 5 | http://data.ris.ripe.net/rrc00/2003.04/bview.20030408.0000.gz 6 | 7 | A good list of descriptions of ASNs is available at 8 | http://www.potaroo.net/bgp/iana/asn-ctl.txt . 9 | 10 | 11 | To test aslookup.pl you can set $format = 1 and then run: 12 | 13 | zcat bview.20030321.1600.gz | time ./zebra-dump-parser.pl >DUMP 2>DUMPERR 14 | sort < DUMP | uniq | time ./aggregate-by-asn.pl > routes.tmp 15 | mv routes.tmp routes 16 | 17 | 18 | If you do something interesting with this software then feel free to 19 | send me an email with some information. 20 | 21 | Marco d'Itri 22 | -------------------------------------------------------------------------------- /drop-stats/doit: -------------------------------------------------------------------------------- 1 | #!/bin/sh -e 2 | 3 | # set $format = 2 in zebra-dump-parser.pl. 4 | 5 | PATH=".:$PATH" 6 | 7 | wget -O data/drop http://www.spamhaus.org/drop/drop.lasso 8 | wget -O data/asn.tmp http://www.potaroo.net/bgp/iana/asn-ctl.txt \ 9 | && mv data/asn.tmp data/asn || true 10 | 11 | wget -c --progress=dot:mega -O data/bview.current.gz \ 12 | http://data.ris.ripe.net/rrc00/$(date +%Y.%m)/bview.$(date +%Y%m%d).0800.gz 13 | zcat data/bview.*.gz | nice zebra-dump-parser.pl > data/routes.tmp 14 | mv data/routes.tmp data/routes 15 | rm -f data/bview.*.gz data/routes.cache 16 | 17 | nice -n 19 \ 18 | drop-stats --as-names=data/asn --drop=data/drop --routes=data/routes \ 19 | > data/drop-stats.txt.tmp 20 | 21 | { 22 | cat info.txt 23 | printf "Generated on: " 24 | date 25 | echo 26 | cat data/drop-stats.txt.tmp 27 | } > drop-stats.txt 28 | rm data/drop-stats.txt.tmp 29 | 30 | -------------------------------------------------------------------------------- /get-asn-names.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # ftp://ftp.ripe.net/ripe/dbase/split/ripe.db.aut-num.gz 3 | 4 | use strict; 5 | 6 | my (%obj, %x); 7 | 8 | my $state = 0; 9 | my $lastobj; 10 | my $lastattr; 11 | while (<>) { 12 | s/[\n\r\s]+$//; 13 | next if /^%/; 14 | s/#.*$//; #? 15 | 16 | # print "[$state] $_\n"; 17 | if ($state == 0) { # wait for a new record 18 | if (/^$/) { 19 | } elsif (/^aut-num:\s+(\S+)/) { 20 | $lastobj = $1; 21 | $obj{$lastobj} = { }; 22 | $state = 1; 23 | } elsif (/^(\S+):/) { 24 | print "DISCARDED: $1\n"; 25 | $state = 99; 26 | } 27 | } elsif ($state == 1) { 28 | if (/^$/) { 29 | $state = 0; 30 | } elsif (/^([a-z-]+):(?:\s+(.+))?/) { 31 | my $value = $2 || ''; 32 | $lastattr = $1; 33 | # print "<$lastobj><$lastattr>\n"; 34 | # use Data::Dumper; print Data::Dumper->Dumpxs([\%obj], ['*obj']); 35 | # BEWARE! This merges multiple attributes! 36 | if (exists $obj{$lastobj}->{$lastattr}) { 37 | $obj{$lastobj}->{$lastattr} .= "\n" . $value; 38 | } else { 39 | $obj{$lastobj}->{$lastattr} .= $value; 40 | } 41 | # XXX what does the + really mean? 42 | } elsif (/^(?:\+?\s+|\+)(.*)/) { # continued attribute 43 | $obj{$lastobj}->{$lastattr} .= "\n" . ($1 || ''); 44 | } else { 45 | print STDERR "[$state][$lastobj] $_\n"; 46 | die; 47 | } 48 | } elsif ($state == 99) { # eat the current record 49 | if (/^$/) { 50 | $state = 0; 51 | } 52 | } else { die "UNKNOWN STATE: $state" } 53 | } 54 | 55 | foreach (keys %obj) { 56 | my $d = $obj{$_}->{descr}; 57 | $d =~ s/\n.*$//mg; 58 | print "$_ $obj{$_}->{'as-name'} $d\n"; 59 | } 60 | 61 | -------------------------------------------------------------------------------- /aslookup.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Getopt::Long; 5 | use Net::Patricia; 6 | 7 | my ($BGP_Dump, $AS_Names, $input); 8 | GetOptions( 9 | 'routes=s' => \$BGP_Dump, # route2country_NO_DATE 10 | 'as-names=s' => \$AS_Names, # asn-ctl.txt 11 | 'input=s' => \$input, 12 | ) or exit 1; 13 | 14 | die "missing parameter" if not $BGP_Dump or not $AS_Names; 15 | 16 | my $pt = new Net::Patricia; 17 | 18 | open(BGPDUMP, $BGP_Dump) or die "cannot open $BGP_Dump: $!"; 19 | while () { 20 | # eval { $pt->add_string((split())[0, 3]) }; 21 | eval { $pt->add_string(split) }; 22 | warn "add_string($_): $@" if $@; 23 | } 24 | close BGPDUMP; 25 | 26 | my %as_name; 27 | open(ASNAMES, $AS_Names) or die "cannot open $AS_Names: $!"; 28 | while () { 29 | s/^AS//; 30 | s/\n//; 31 | s/#.*$//; 32 | # my ($as, $desc) = split(/\s+/, $_, 2); 33 | my ($as, undef, undef, $desc) = split(/\s+/, $_, 4); 34 | $as_name{$as} = $desc; 35 | } 36 | close ASNAMES; 37 | 38 | if ($input) { 39 | open(INPUT, $input) or die "cannot open $input: $!\n"; 40 | } else { 41 | open(INPUT, '<&STDIN') or die; 42 | } 43 | 44 | my %by_asn; 45 | my $total = 0; 46 | while () { 47 | my ($queries, $ip) = split; 48 | 49 | next if not $ip; 50 | my $asn = eval { $pt->match_string($ip) }; 51 | warn "match_string($ip): $@" if $@; 52 | $asn ||= " UNKN ($ip)"; 53 | if (exists $by_asn{$asn}) { 54 | $by_asn{$asn} += $queries; 55 | } else { 56 | $by_asn{$asn} = $queries; 57 | } 58 | $total += $queries; 59 | } 60 | close INPUT if $input; 61 | 62 | print "Total queries: $total\n\n"; 63 | print " queries ASN\n------+--------+-----\n"; 64 | foreach (reverse sort { $by_asn{$a} <=> $by_asn{$b} } keys %by_asn) { 65 | my $perc = ($by_asn{$_} * 100) / $total; 66 | printf('%02.2f%% %8d %5s', $perc, $by_asn{$_}, $_); 67 | print " $as_name{$_}" if exists $as_name{$_}; 68 | print "\n"; 69 | } 70 | 71 | exit 0; 72 | 73 | -------------------------------------------------------------------------------- /aggregate-by-asn.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | use strict; 4 | use Net::IP; # libnet-ip-perl 5 | 6 | my %as; 7 | while (<>) { 8 | my ($pref, $asn) = split; 9 | push(@{$as{$asn}}, $pref); 10 | } 11 | 12 | foreach my $asn (keys %as) { 13 | if (scalar @{$as{$asn}} <= 1) { 14 | print @{$as{$asn}}[0] . " $asn\n"; 15 | next; 16 | } 17 | 18 | my @nets = map { Net::IP->new($_) or die "Not an IP: $_" } @{$as{$asn}}; 19 | sort_networks(\@nets); 20 | #remove_overlaps(\@nets); 21 | aggregate(\@nets); 22 | print $_->prefix . " $asn\n" foreach @nets; 23 | } 24 | exit 0; 25 | 26 | sub sort_networks { 27 | my $addrs = $_[0]; 28 | 29 | @$addrs = sort { 30 | $a->bincomp('lt', $b) ? -1 : ($a->bincomp('gt', $b) ? 1 : 0); 31 | } @$addrs; 32 | } 33 | 34 | # this function is unfinished... 35 | sub aggregate { 36 | my $addrs = $_[0]; 37 | 38 | # continue aggregating until there are no more changes to do 39 | my $changed = 1; 40 | while ($changed) { 41 | $changed = 0; 42 | my @new_addrs; 43 | my $prev = $addrs->[0]; 44 | foreach my $cur (@$addrs[1 .. $#{$addrs}]) { 45 | if (my $aggregated = $prev->aggregate($cur)) { 46 | $prev = $aggregated; 47 | $changed = 1; 48 | } else { 49 | push(@new_addrs, $prev); 50 | $prev = $cur; 51 | } 52 | } 53 | push(@new_addrs, $prev); 54 | @$addrs = @new_addrs; 55 | } 56 | } 57 | 58 | sub remove_overlaps { 59 | my $addrs = $_[0]; 60 | 61 | my @nets; 62 | my $prev = $addrs->[0]; 63 | foreach my $cur (@$addrs[1..$#{$addrs}]) { 64 | my $how = $prev->overlaps($cur); 65 | if ($how == $IP_NO_OVERLAP) { 66 | push(@nets, $prev); 67 | } elsif ($how == $IP_A_IN_B_OVERLAP) { # cur contains prev 68 | warn "A IN B p:".$prev->prefix." c:".$cur->prefix."\n"; 69 | push(@nets, $prev); 70 | } elsif ($how == $IP_B_IN_A_OVERLAP) { # prev contains cur 71 | warn "B IN A p:".$prev->prefix." c:".$cur->prefix."\n"; 72 | push(@nets, $prev); 73 | } elsif ($how == $IP_IDENTICAL) { 74 | # } elsif ($how == $IP_PARTIAL_OVERLAP) { 75 | } else { 76 | warn "Error: " . $prev->prefix . " overlaps " . $cur->prefix 77 | . " ($how).\n"; 78 | # push(@nets, $prev); # ??? 79 | } 80 | $prev = $cur; 81 | } 82 | @$addrs = @nets; 83 | } 84 | 85 | -------------------------------------------------------------------------------- /drop-stats/drop-stats: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # This program generates statistics about the networks listed in SBL DROP, 4 | # who announces them, what else they announce and who is providing transit 5 | # to who announces them. 6 | # 7 | # BEWARE: the term "transit" in this program is used improperly to denote 8 | # both transit and and peering relationships! 9 | # 10 | # This program is free software; you can redistribute it and/or modify 11 | # it under the terms of the GNU General Public License version 2 or later 12 | # as published by the Free Software Foundation. 13 | 14 | use strict; 15 | use warnings; 16 | 17 | use Getopt::Long; 18 | use Net::Patricia; 19 | use List::Util qw(sum); 20 | use Storable; 21 | 22 | ############################################################################## 23 | my ($BGP_Dump, $AS_Names, $Drop, $Good_Bad_Cutoff); 24 | GetOptions( 25 | 'routes=s' => \$BGP_Dump, 26 | 'as-names=s' => \$AS_Names, 27 | 'drop=s' => \$Drop, 28 | 'cutoff=i' => \$Good_Bad_Cutoff, 29 | ) or exit 1; 30 | 31 | die "missing parameter" if not ($BGP_Dump and $AS_Names and $Drop); 32 | 33 | # report if an ASN announces <= than this many networks not in DROP 34 | $Good_Bad_Cutoff ||= 6; 35 | 36 | ############################################################################## 37 | my ($drop, $dropnum) = parse_drop_data($Drop); 38 | my $as_name = parse_asn_names_data($AS_Names); 39 | my ($origins, $transits, $announces) = parse_bgp_data($BGP_Dump); 40 | 41 | ############################################################################## 42 | # the number of listed networks announced by each AS 43 | my %origins_stats = map { 44 | $_ => scalar keys %{$origins->{$_}} 45 | } keys %$origins; 46 | 47 | # list of ASes announcing only networks listed by SBL DROP 48 | my %is_evil_as; 49 | 50 | # does not include downstream ASes 51 | print "Listed networks announced by each AS:\n"; 52 | foreach my $asn (reverse sort { 53 | $origins_stats{$a} <=> $origins_stats{$b} || $a <=> $b 54 | } keys %origins_stats) { 55 | my $announced = scalar keys %{$announces->{$asn}}; 56 | 57 | my @not_listed; 58 | printf('%2d %5s', $origins_stats{$asn}, $asn); 59 | print " $as_name->{$asn}" if exists $as_name->{$asn}; 60 | if ($announced == 0) { 61 | print " [ALL LISTED]"; 62 | $is_evil_as{$asn} = undef; 63 | } elsif ($announced <= $Good_Bad_Cutoff) { 64 | @not_listed = keys %{$announces->{$asn}}; 65 | } else { 66 | print " [of $announced]"; 67 | } 68 | print "\n"; 69 | print ' ' . join(' ', sort keys %{$origins->{$asn}}) . "\n"; 70 | print ' Not listed: ' . join(' ', sort @not_listed) . "\n" 71 | if @not_listed; 72 | } 73 | 74 | print "\n" .(+ keys %$origins) 75 | . " of $dropnum listed networks are announced.\n"; 76 | print scalar(keys %is_evil_as) 77 | . " ASes are announcing only listed networks.\n"; 78 | 79 | ############################################################################## 80 | my (%evil_transits_stats, %bad_transits_stats); 81 | foreach my $asn (keys %$transits) { 82 | # the number of listed networks received by transits of each unclean AS 83 | my $sum = sum( 84 | map { 85 | # the number of listed networks announced by each unclean AS 86 | scalar keys %{$transits->{$asn}->{$_}} 87 | } keys %{$transits->{$asn}} # each transited unclean AS 88 | ); 89 | 90 | # check if there is an evil AS in the list of transited ASes 91 | my $evil; 92 | foreach (%{$transits->{$asn}}) { 93 | next if not exists $is_evil_as{$_}; 94 | $evil = 1; 95 | last; 96 | } 97 | 98 | if ($evil) { 99 | $evil_transits_stats{$asn} = $sum; 100 | } else { 101 | $bad_transits_stats{$asn} = $sum; 102 | } 103 | } 104 | 105 | ############################################################################## 106 | print "\nListed networks received by neighbors of evil ASes:\n"; 107 | foreach my $asn (reverse sort { 108 | $evil_transits_stats{$a} <=> $evil_transits_stats{$b} || 109 | $a <=> $b 110 | } keys %evil_transits_stats) { 111 | printf('%2d %5s', $evil_transits_stats{$asn}, $asn); 112 | print " $as_name->{$asn}" if exists $as_name->{$asn}; 113 | print "\n"; 114 | print ' from AS: ' 115 | . join(' ', sort { $a <=> $b } keys %{$transits->{$asn}}) . "\n"; 116 | } 117 | 118 | print "\nListed networks received by neighbors of bad ASes:\n"; 119 | foreach my $asn (reverse sort { 120 | $bad_transits_stats{$a} <=> $bad_transits_stats{$b} || 121 | $a <=> $b 122 | } keys %bad_transits_stats) { 123 | printf('%2d %5s', $bad_transits_stats{$asn}, $asn); 124 | print " $as_name->{$asn}" if exists $as_name->{$asn}; 125 | print "\n"; 126 | print ' from AS: ' 127 | . join(' ', sort { $a <=> $b } keys %{$transits->{$asn}}) . "\n"; 128 | } 129 | 130 | #use Data::Dumper; print Dumper($origins, $transits); 131 | #use Data::Dumper; print Dumper($announces); 132 | #use Data::Dumper; print Dumper(\%origins_stats, \%evil_transits_stats, \%bad_transits_stats); 133 | 134 | exit 0; 135 | 136 | ############################################################################## 137 | sub parse_drop_data { 138 | my ($file) = @_; 139 | 140 | my $drop = new Net::Patricia; 141 | my $dropnum = 0; 142 | 143 | open(DROP, $file) or die "cannot open $file: $!\n"; 144 | 145 | while () { 146 | next if /^;/ or /^$/; 147 | my ($net, $sbl) = /^(\S+)\s*;\s*(\S+)/; 148 | eval { $drop->add_string($net, [$sbl, $net]); }; 149 | warn "add_string($_): $@" if $@; 150 | $dropnum++; 151 | } 152 | close DROP; 153 | 154 | return ($drop, $dropnum); 155 | } 156 | 157 | ############################################################################## 158 | sub parse_asn_names_data { 159 | my ($file) = @_; 160 | my $as_name; 161 | 162 | open(ASNAMES, $file) or die "cannot open $file: $!"; 163 | while () { 164 | s/\n//; 165 | next if /^$/; 166 | next if /^1\./; # hack to ignored reserved ASN32 names 167 | s/^AS//; 168 | s/#.*$//; 169 | #my ($as, $desc) = split(/\s+/, $_, 2); 170 | my ($as, undef, undef, $desc) = split(/\s+/, $_, 4); 171 | $as_name->{$as} = $desc; 172 | } 173 | close ASNAMES; 174 | 175 | return $as_name; 176 | } 177 | 178 | ############################################################################## 179 | sub parse_bgp_data { 180 | my ($file) = @_; 181 | my $cache_file = $file . '.cache'; 182 | 183 | if (-e $cache_file) { 184 | my $cached_data = retrieve($cache_file) 185 | or die "retrieve($cache_file): $!"; 186 | return @$cached_data; 187 | } 188 | 189 | my @data = real_parse_bgp_data(@_); 190 | store(\@data, $cache_file) or die "store($cache_file): $!"; 191 | 192 | return @data; 193 | } 194 | 195 | sub real_parse_bgp_data { 196 | my ($file) = @_; 197 | my ($origins, $transits, $announces); 198 | 199 | open(BGPDUMP, $file) or die "cannot open $file: $!"; 200 | while () { 201 | my ($net, @as) = split; 202 | remove_prepends(\@as); 203 | my ($origin, $transit) = @as[-1,-2]; 204 | 205 | # ignore the RIPE RIS peerings 206 | next if not $origin or ($transit and $transit eq 3333); 207 | 208 | # lookup the route in the DROP list 209 | my ($result) = eval { $drop->match_string($net); }; 210 | warn "match_string($net): $@", next if $@; 211 | 212 | if (not $result) { # not listed 213 | # non-listed networks announced by AS $origin 214 | $announces->{$origin}->{$net} = undef; 215 | next; 216 | } 217 | 218 | my $sbl = $result->[0]; 219 | #print "$sbl ==> $net <$origin> <$transit>\n"; 220 | 221 | # listed networks announced by AS $origin 222 | $origins->{$origin}->{$sbl} = $net; 223 | # listed networks transited by AS $transit for AS $origin 224 | $transits->{$transit}->{$origin}->{$sbl} = $net if $transit; 225 | } 226 | close BGPDUMP; 227 | 228 | return ($origins, $transits, $announces); 229 | } 230 | 231 | ############################################################################## 232 | sub remove_prepends { 233 | my ($as) = @_; 234 | my $last = ''; 235 | 236 | my @newas; 237 | for (my $i = 0; $i < @$as; $i++) { 238 | next if $last eq $as->[$i]; 239 | push(@newas, $as->[$i]); 240 | $last = $as->[$i]; 241 | } 242 | @{$as} = @newas; 243 | 244 | return; 245 | } 246 | 247 | -------------------------------------------------------------------------------- /zebra-dump-parser.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | # 3 | # This program is free software; you can redistribute it and/or modify 4 | # it under the terms of the GNU General Public License version 2 or later 5 | # as published by the Free Software Foundation. 6 | # 7 | # This work is inspired by the route_btoa.pl program by Craig Labovitz 8 | # , which is part of the MRT distribution. 9 | # 10 | # Documentation about the zebra/MRT packet format: 11 | # http://www.iana.org/assignments/mrt/mrt.xml 12 | # http://tools.ietf.org/html/rfc6396 13 | 14 | use warnings; 15 | use strict; 16 | require 5.008; 17 | 18 | # only meaningful for message types TABLE_DUMP and TABLE_DUMP_V2 19 | # 1: verbose dump 2: AS path 3: origin AS 20 | my $format = 3; 21 | my $ignore_v6_routes = 1; 22 | 23 | ############################################################################## 24 | use constant { 25 | MSG_BGP => 5, # MRT only 26 | MSG_BGP4PLUS => 9, # MRT only 27 | MSG_TABLE_DUMP => 12, # dump bgp routes-mrt 28 | MSG_TABLE_DUMP_V2 => 13, # RIPE RIS 29 | MSG_BGP4MP => 16, # dump bgp all 30 | 31 | BGP4MP_STATE_CHANGE => 0, 32 | BGP4MP_MESSAGE => 1, 33 | BGP4MP_ENTRY => 2, # deprecated 34 | BGP4MP_SNAPSHOT => 3, # deprecated 35 | BGP4MP_MESSAGE_AS4 => 4, 36 | BGP4MP_STATE_CHANGE_AS4 => 5, 37 | BGP4MP_MESSAGE_LOCAL => 6, 38 | BGP4MP_MESSAGE_AS4_LOCAL => 7, 39 | 40 | AFI_IP => 1, 41 | AFI_IP6 => 2, 42 | 43 | # for TABLE_DUMP_V2 44 | INDEX_TABLE => 1, 45 | RIB_IPV4_UNICAST => 2, 46 | RIB_IPV4_MULTICAST => 3, 47 | RIB_IPV6_UNICAST => 4, 48 | RIB_IPV6_MULTICAST => 5, 49 | RIB_GENERIC => 6, 50 | 51 | BGP_TYPE_OPEN => 1, 52 | BGP_TYPE_UPDATE => 2, 53 | BGP_TYPE_NOTIFICATION => 3, 54 | BGP_TYPE_KEEPALIVE => 4, 55 | 56 | BGP_ATTR_FLAG_EXTLEN => 0x10, 57 | 58 | AS_SET => 1, 59 | 60 | BGP_ATTR_ORIGIN => 1, 61 | BGP_ATTR_AS_PATH => 2, 62 | BGP_ATTR_NEXT_HOP => 3, 63 | BGP_ATTR_MULTI_EXIT_DISC => 4, 64 | BGP_ATTR_LOCAL_PREF => 5, 65 | BGP_ATTR_ATOMIC_AGGREGATE => 6, 66 | BGP_ATTR_AGGREGATOR => 7, 67 | BGP_ATTR_COMMUNITIES => 8, 68 | BGP_ATTR_ORIGINATOR_ID => 9, 69 | BGP_ATTR_CLUSTER_LIST => 10, 70 | ## BGP_ATTR_DPA => 11, 71 | # BGP_ATTR_ADVERTISER => 12, 72 | ## BGP_ATTR_RCID_PATH => 13, 73 | BGP_ATTR_MP_REACH_NLRI => 14, 74 | BGP_ATTR_MP_UNREACH_NLRI => 15, 75 | BGP_ATTR_EXT_COMMUNITIES => 16, 76 | }; 77 | 78 | my @BGP_ORIGIN = qw(IGP EGP Incomplete); 79 | 80 | ############################################################################## 81 | open(INPUT, '-') or die "Could not open INPUT $!\n"; 82 | 83 | use constant BUF_READ_SIZE => 4096 * 8; 84 | my $buf = ''; 85 | my $read_done = 0; 86 | 87 | my @BGP_Peers; # used by the TABLE_DUMP_V2 parser 88 | 89 | while (1) { 90 | if ($read_done) { 91 | last if length $buf == 0; 92 | } elsif (length $buf < BUF_READ_SIZE) { 93 | my $tmp = ''; 94 | my $n = sysread(INPUT, $tmp, BUF_READ_SIZE * 2); 95 | die "sysread: $!" if not defined $n; 96 | $read_done = 1 if $n == 0; 97 | $buf .= $tmp; 98 | } 99 | 100 | die "short file (empty packet)" if not $buf; 101 | my $header = substr($buf, 0, 12, ''); 102 | my ($time, $type, $subtype, $packet_length) = unpack('N n n N', $header); 103 | my $packet = substr($buf, 0, $packet_length, ''); 104 | die "short file (got " . (length $packet) . " of $packet_length bytes)" 105 | if $packet_length != length $packet; 106 | 107 | if ($format == 1) { 108 | my ($sec, $min, $hour, $mday, $mon, $year, @junk) = localtime($time); 109 | $mon++; 110 | $year += 1900; 111 | printf("\nTIME: $year-$mon-$mday %02d:%02d:%02d\n", $hour, $min, $sec); 112 | } 113 | 114 | decode_mrt_packet(\$packet, $type, $subtype); 115 | } 116 | exit 0; 117 | 118 | ############################################################################## 119 | sub decode_mrt_packet { 120 | my ($pkt, $type, $subtype) = @_; 121 | 122 | if ($type == MSG_TABLE_DUMP) { ########################################### 123 | my $af = $subtype; 124 | my $header_format; 125 | 126 | if ($af == AFI_IP) { 127 | $header_format = 'n n a4 C C N a4 n n/a'; 128 | } elsif ($af == AFI_IP6) { 129 | return if $ignore_v6_routes; 130 | $header_format = 'n n a16 C C N a16 n n/a'; 131 | } else { 132 | warn "TYPE: MSG_TABLE_DUMP/AFI_UNKNOWN_$af\n"; 133 | return; 134 | } 135 | 136 | my ($viewno, $seq_num, $prefix, $prefixlen, undef, $originated, 137 | $peerip, $peer_as, $attributes) = unpack($header_format, $$pkt); 138 | my $attr = parse_attributes($attributes); 139 | 140 | if ($format == 1) { 141 | print "TYPE: MSG_TABLE_DUMP/" . 142 | ($af == AFI_IP ? 'AFI_IP' : 'AFI_IP6') . "\n" 143 | . "VIEW: $viewno SEQUENCE: $seq_num\n" 144 | . 'PREFIX: ' . inet_ntop($af, $prefix) . "/$prefixlen\n" 145 | . "ORIGINATED: " . localtime($originated) . "\n"; 146 | print 'FROM: ' . inet_ntop($af, $peerip) . " AS$peer_as\n" 147 | if $peer_as; 148 | print_verbose_attributes($attr); 149 | } elsif ($format == 2) { 150 | print inet_ntop($af, $prefix) . "/$prefixlen" 151 | . print_aspath($attr->[BGP_ATTR_AS_PATH]) . "\n"; 152 | } elsif ($format == 3) { 153 | print inet_ntop($af, $prefix) . "/$prefixlen " 154 | . unpack('n', origin_as($attr->[BGP_ATTR_AS_PATH])) . "\n" 155 | if @{$attr->[BGP_ATTR_AS_PATH]}; 156 | } else { die } 157 | } elsif ($type == MSG_TABLE_DUMP_V2) { ################################### 158 | my $af; 159 | 160 | if ($subtype == INDEX_TABLE) { 161 | my ($collector_id, $view_name, $peers_count, $rest) 162 | = unpack('a4 n/a n a*', $$pkt); 163 | $view_name ||= ''; 164 | print "TYPE: MSG_TABLE_DUMP_V2/INDEX_TABLE\n". 165 | "ID: " . inet_ntoa($collector_id) . 166 | "\nVIEW_NAME: \"$view_name\", PEERS: $peers_count\n" 167 | if $format == 1; 168 | 169 | # unpack each peer 170 | my $peer_index = 0; 171 | while (length $rest > 0) { 172 | # parse only the first byte (peer type, a bit field) to 173 | # known the length of the other fields of $rest 174 | my ($addrv6, $as32) = split(//, unpack('b8', $rest)); 175 | my $as_size = $as32 ? 4 : 2; 176 | my $mformat = 'x N' . ($addrv6 ? 'a16' : 'a4') . "a$as_size a*"; 177 | 178 | my ($bgp_id, $peer_ip, $peer_as); 179 | ($bgp_id, $peer_ip, $peer_as, $rest) = unpack($mformat, $rest); 180 | $peer_as = pretty_as($peer_as); 181 | 182 | my $afi = $addrv6 ? AFI_IP6 : AFI_IP; 183 | print " PEER $peer_index: ID: $bgp_id, " 184 | . inet_ntop($afi, $peer_ip) . ", AS$peer_as\n" 185 | if $format == 1; 186 | $BGP_Peers[$peer_index++] = [ 187 | $bgp_id, $afi, $peer_ip, $peer_as, $as_size, 188 | ]; 189 | } 190 | 191 | return; 192 | } elsif ($subtype == RIB_IPV4_UNICAST) { 193 | $af = AFI_IP; 194 | } elsif ($subtype == RIB_IPV4_MULTICAST) { 195 | return if $ignore_v6_routes; 196 | $af = AFI_IP; 197 | } elsif ($subtype == RIB_IPV6_UNICAST) { 198 | return if $ignore_v6_routes; 199 | $af = AFI_IP6; 200 | } elsif ($subtype == RIB_IPV6_MULTICAST) { 201 | return if $ignore_v6_routes; 202 | $af = AFI_IP6; 203 | } elsif ($subtype == RIB_GENERIC) { 204 | my ($seq_num, $afi, $safi, $nlri) = unpack('N n C a*', $$pkt); 205 | #my (?, $entry_count, $rest) = unpack("? n a*", $nlri); 206 | print "TYPE: MSG_TABLE_DUMP_V2/RIB_GENERIC\n" 207 | . "SEQUENCE: $seq_num\n" 208 | . "AFI: $afi, SAFI: $safi, NLRI(" . length($nlri) ."):\n"; 209 | hexdump($nlri); 210 | return; 211 | } else { 212 | warn "TYPE: MSG_TABLE_DUMP_V2/UNKNOWN_SUBTYPE_$subtype\n"; 213 | return; 214 | } 215 | 216 | my ($seq_num, $prefixlen, $nlri) = unpack('N C a*', $$pkt); 217 | my $bytes = int($prefixlen / 8) + ($prefixlen % 8 ? 1 : 0); 218 | my ($prefix, $entry_count, $rest) = unpack("a$bytes n a*", $nlri); 219 | $prefix .= "\0" x (($af == AFI_IP ? 4 : 16) - $bytes); # pad with NULs 220 | 221 | while (length $rest > 0) { 222 | my ($peer_index, $originated, $attributes); 223 | ($peer_index, $originated, $attributes, $rest) 224 | = unpack('n N n/a a*', $rest); 225 | my $attr = parse_attributes($attributes, 226 | $BGP_Peers[$peer_index]->[4]); 227 | 228 | if ($format == 1) { 229 | print "TYPE: MSG_TABLE_DUMP_V2/ENTRY_" . 230 | ($af == AFI_IP ? 'AFI_IP' : 'AFI_IP6') . "\n" 231 | . "SEQUENCE: $seq_num\n" 232 | . 'PREFIX: ' . inet_ntop($af, $prefix) . "/$prefixlen\n" 233 | . "ORIGINATED: " . localtime($originated) . "\n"; 234 | my $peer_as = $BGP_Peers[$peer_index]->[3]; 235 | print 'FROM: ' . inet_ntop($af, $BGP_Peers[$peer_index]->[2]) 236 | . " AS$peer_as\n"; 237 | print_verbose_attributes($attr); 238 | print "-\n"; 239 | } elsif ($format == 2) { 240 | print inet_ntop($af, $prefix) . "/$prefixlen" 241 | . print_aspath($attr->[BGP_ATTR_AS_PATH]) . "\n"; 242 | } elsif ($format == 3) { 243 | print inet_ntop($af, $prefix) . "/$prefixlen " 244 | . unpack($BGP_Peers[$peer_index]->[4] == 2 ? 'n' : 'N', 245 | origin_as($attr->[BGP_ATTR_AS_PATH])) . "\n" 246 | if @{$attr->[BGP_ATTR_AS_PATH]}; 247 | } else { die } 248 | } 249 | 250 | } elsif ($type == MSG_BGP4MP) { ########################################## 251 | if ($subtype == BGP4MP_STATE_CHANGE) { #------------------------------ 252 | my ($srcas, $dstas, $ifidx, $af, $rest) = unpack('nnnn a*', $$pkt); 253 | my $unpack_format; 254 | 255 | if ($af == AFI_IP) { 256 | $unpack_format = 'a4 a4 n n'; 257 | } elsif ($af == AFI_IP6) { 258 | $unpack_format = 'a16 a16 n n'; 259 | } else { 260 | warn "TYPE: BGP4MP/BGP4MP_STATE_CHANGE AFI_UNKNOWN_$af\n"; 261 | return; 262 | } 263 | 264 | my ($srcip, $dstip, $old_state, $new_state) 265 | = unpack($unpack_format, $rest); 266 | print "TYPE: BGP4MP/BGP4MP_STATE_CHANGE " . 267 | ($af == AFI_IP ? 'AFI_IP' : 'AFI_IP6' ) . "\n"; 268 | print "FROM: " . inet_ntop($af, $srcip) . "\n" if notnull($srcip); 269 | print "TO: " . inet_ntop($af, $dstip) . "\n" if notnull($dstip); 270 | print "OLD STATE: $old_state NEW STATE: $new_state\n"; 271 | # state numbers: see RFC 4271, Appendix 1 272 | # 1:IDLE 2:CONNECT 3:ACTIVE 4:OPENSENT 5:OPENCONFIRM 6:ESTABLISHED 273 | } elsif ($subtype == BGP4MP_MESSAGE or #------------------------------ 274 | $subtype == BGP4MP_MESSAGE_AS4) { 275 | my ($subtype_str, $asn_unpack_format, $asn_length); 276 | if ($subtype == BGP4MP_MESSAGE) { 277 | $subtype_str = 'BGP4MP_MESSAGE'; 278 | $asn_unpack_format = 'nnnn a*'; # 16 bit ASNs 279 | } else { 280 | $subtype_str = 'BGP4MP_MESSAGE_AS4'; 281 | $asn_unpack_format = 'NNnn a*'; # 32 bit ASNs 282 | $asn_length = 4; 283 | } 284 | my ($srcas, $dstas, $ifidx, $af, $rest) = 285 | unpack($asn_unpack_format, $$pkt); 286 | 287 | my $unpack_format; 288 | if ($af == AFI_IP) { 289 | $unpack_format = 'a4 a4 a*'; 290 | } elsif ($af == AFI_IP6) { 291 | $unpack_format = 'a16 a16 a*'; 292 | } else { 293 | warn "TYPE: BGP4MP/$subtype_str AFI_UNKNOWN_$af\n"; 294 | return; 295 | } 296 | 297 | my ($srcip, $dstip, $bgppkt) = unpack($unpack_format, $rest); 298 | print "TYPE: BGP4MP/$subtype_str " . 299 | ($af == AFI_IP ? 'AFI_IP' : 'AFI_IP6' ) . "\n"; 300 | print "FROM: " . inet_ntop($af, $srcip) . "\n" if notnull($srcip); 301 | print "TO: " . inet_ntop($af, $dstip) . "\n" if notnull($dstip); 302 | parse_bgp_packet($bgppkt, $asn_length); 303 | } elsif ($subtype == BGP4MP_ENTRY) { #-------------------------------- 304 | warn "NOT TESTED"; # XXX 305 | my ($view, $status, $time_change, $afi, $safi, $next_hop, $prefix, 306 | $attributes) = unpack('n n N n C C/a C/a n/a', $$pkt); 307 | my $attr = parse_attributes($attributes); 308 | 309 | print "TYPE: BGP4MP/BGP4MP_ENTRY " 310 | . ($afi == AFI_IP ? 'AFI_IP' : 'AFI_IP6' ) . "\n"; 311 | print_verbose_attributes($attr); 312 | } else { #------------------------------------------------------------ 313 | print "TYPE: BGP4MP/BGP4MP_UNKNOWN-$subtype\n"; 314 | hexdump($$pkt); 315 | } 316 | } elsif ($type == MSG_BGP4PLUS ########################################### 317 | or $type == MSG_BGP) { ############################################# 318 | my $unpack_format = ($type == MSG_BGP4PLUS) 319 | ? 'n a16 n a16 n/a n/a a*' : 'n a4 n a4 n/a n/a a*'; 320 | my $afi = ($type == MSG_BGP4PLUS) ? AFI_IP6 : AFI_IP; 321 | my ($srcas, $srcip, $dstas, $dstip, $unf_routes, $attributes, $nlri) 322 | = unpack($unpack_format, $$pkt); 323 | my $attr = parse_attributes($attributes); 324 | 325 | print "TYPE: TYPE: BGP4MP/BGP4" 326 | . ($afi == AFI_IP ? '' : 'PLUS') . "/UPDATE\n"; 327 | print "FROM: " . inet_ntop($afi, $srcip) . " AS$srcas\n" if $srcas; 328 | print "TO: " . inet_ntop($afi, $dstip) . " AS$dstas\n" if $dstas; 329 | print_verbose_attributes($attr); 330 | print "WITHDRAWN: $_\n" foreach (parse_nlri_prefixes($unf_routes)); 331 | print "ANNOUNCE: $_\n" foreach (parse_nlri_prefixes($nlri)); 332 | } else { ################################################################ 333 | warn "UNKNOWN TYPE: $type SUBTYPE: $subtype\n"; 334 | } 335 | } 336 | 337 | sub parse_attributes { 338 | my ($attributes, $as_size) = @_; 339 | my @attr; 340 | 341 | while (length $attributes > 0) { 342 | my ($flags, $type); 343 | ($flags, $type, $attributes) = unpack('C C a*', $attributes); 344 | 345 | my $attrib; # content of the next attribute 346 | if ($flags & BGP_ATTR_FLAG_EXTLEN) { 347 | ($attrib, $attributes) = unpack('n/a a*', $attributes); 348 | } else { 349 | ($attrib, $attributes) = unpack('C/a a*', $attributes); 350 | } 351 | 352 | if ($type == BGP_ATTR_ORIGIN) { 353 | $attr[BGP_ATTR_ORIGIN] = unpack('C', $attrib); 354 | } elsif ($type == BGP_ATTR_AS_PATH) { 355 | $attr[BGP_ATTR_AS_PATH] = [ ]; 356 | $as_size ||= 2; 357 | while (length $attrib > 0) { 358 | my ($seg_type, $seg_length); 359 | ($seg_type, $seg_length, $attrib) = unpack('C C a*', $attrib); 360 | my $seg_value = substr($attrib, 0, $seg_length * $as_size, ''); 361 | push(@{$attr[BGP_ATTR_AS_PATH]}, 362 | [ $seg_type, [ unpack("(a$as_size)*", $seg_value) ] ]); 363 | } 364 | } elsif ($type == BGP_ATTR_NEXT_HOP) { 365 | $attr[BGP_ATTR_NEXT_HOP] = $attrib; # IPv4 366 | } elsif ($type == BGP_ATTR_MULTI_EXIT_DISC) { 367 | $attr[BGP_ATTR_MULTI_EXIT_DISC] = $attrib; # 'N' 368 | } elsif ($type == BGP_ATTR_LOCAL_PREF) { 369 | $attr[BGP_ATTR_LOCAL_PREF] = $attrib; # 'N' 370 | } elsif ($type == BGP_ATTR_ATOMIC_AGGREGATE) { 371 | $attr[BGP_ATTR_ATOMIC_AGGREGATE] = 1; 372 | } elsif ($type == BGP_ATTR_AGGREGATOR) { 373 | $attr[BGP_ATTR_AGGREGATOR] = [ unpack('a2 a4', $attrib) ];# N, IPv4 374 | } elsif ($type == BGP_ATTR_COMMUNITIES) { 375 | $attr[BGP_ATTR_COMMUNITIES] = [ ]; 376 | while (length $attrib > 0) { 377 | my $community = substr($attrib, 0, 4, ''); 378 | push(@{$attr[BGP_ATTR_COMMUNITIES]}, $community); 379 | } 380 | } elsif ($type == BGP_ATTR_MP_REACH_NLRI) { 381 | # FIXME v2 uses a different format 382 | my ($afi, $safi, $next_hop, $rest) = unpack('n C C/a a*', $attrib); 383 | 384 | # XXX how should I deal with all these cases? 385 | my $next_hop_len = length $next_hop; 386 | my ($next_hop_global_in, $next_hop_global, $next_hop_local); 387 | if ($next_hop_len == 4) { 388 | $next_hop_global_in = $next_hop; 389 | } elsif ($next_hop_len == 12) { 390 | my ($rd_high, $rd_low); 391 | ($rd_high, $rd_low, $next_hop_global_in) 392 | = unpack('N N a4', $next_hop); 393 | } elsif ($next_hop_len == 16) { 394 | $next_hop_global = $next_hop; 395 | } elsif ($next_hop_len == 32) { 396 | ($next_hop_global, $next_hop_local) 397 | = unpack('a16 a16', $next_hop); 398 | } else { die } 399 | 400 | my $num_snpa; 401 | ($num_snpa, $rest) = unpack('C a*', $rest); 402 | while ($num_snpa-- > 0) { 403 | my $snpa; 404 | ($snpa, $rest) = unpack('C/a a*', $rest); 405 | print "|SNPA: "; hexdump($snpa); # XXX 406 | } 407 | 408 | if ($format == 1) { # XXX should not print here... 409 | print "|AFI: $afi ($safi)\n"; 410 | print "|NEXT_HOP: " . inet6_ntoa($next_hop_global) 411 | . " (LENGTH: $next_hop_len)\n"; 412 | print "|ANNOUNCE: $_\n" foreach (parse_nlri_prefixes($rest, $afi)); 413 | } 414 | } elsif ($type == BGP_ATTR_MP_UNREACH_NLRI) { 415 | my ($afi, $safi, $nlri) = unpack('n C a*', $attrib); 416 | 417 | if ($format == 1) { # XXX 418 | print "|WITHDRAWN: $_\n" foreach(parse_nlri_prefixes($nlri, $afi)); 419 | } 420 | } elsif ($type == BGP_ATTR_ORIGINATOR_ID) { 421 | $attr[BGP_ATTR_ORIGINATOR_ID] = $attrib; # IPv4 422 | } elsif ($type == BGP_ATTR_CLUSTER_LIST) { 423 | $attr[BGP_ATTR_CLUSTER_LIST] = $attrib; # IPv4 424 | } else { 425 | warn "Unknown BGP attribute $type (flags: $flags)\n"; 426 | } 427 | } 428 | 429 | return \@attr; 430 | } 431 | 432 | sub parse_bgp_packet { 433 | my ($bgppkt, $asn_length) = @_; 434 | 435 | my ($marker, $length, $type, $data) = unpack('a16 n C a*', $bgppkt); 436 | 437 | if ($type == BGP_TYPE_OPEN) { 438 | my ($version, $as, $hold_time, $bgp_id, $params) 439 | = unpack('C n n a4 C/a', $data); 440 | # die if $version != 4; 441 | print "BGP PACKET TYPE: OPEN\n" 442 | . "AS: $as ID: " . inet_ntoa($bgp_id) . "\n" 443 | . "HOLD TIME: ${hold_time}s\n"; 444 | 445 | # parse BGP OPEN parameters 446 | while (length $params > 0) { 447 | my ($par_type, $par_value); 448 | ($par_type, $par_value, $params) = unpack('C C/a a*', $params); 449 | if ($par_type == 1) { 450 | my ($code, $data) = unpack('C a*', $par_value); 451 | print "PARAMETER: AUTH code $code\n"; 452 | } elsif ($par_type == 2) { 453 | my $caps = $par_value; 454 | while (length $caps > 0) { 455 | my ($cap_code, $cap_value); 456 | ($cap_code, $cap_value, $caps) = unpack('C C/a a*', $caps); 457 | # see http://www.iana.org/assignments/capability-codes 458 | print "PARAMETER: CAPABILITY $cap_code\n"; 459 | } 460 | } else { 461 | print "PARAMETER: TYPE $par_type (UNKNOWN) " 462 | . "LEN: " . length($params) . "\n"; 463 | hexdump($params); 464 | } 465 | } 466 | } elsif ($type == BGP_TYPE_UPDATE) { 467 | print "BGP PACKET TYPE: UPDATE\n"; 468 | my ($unf_routes, $attributes, $nlri) = unpack('n/a n/a a*', $data); 469 | my $attr = parse_attributes($attributes, $asn_length); 470 | print_verbose_attributes($attr); 471 | print "WITHDRAWN: $_\n" foreach (parse_nlri_prefixes($unf_routes)); 472 | print "ANNOUNCED: $_\n" foreach (parse_nlri_prefixes($nlri)); 473 | } elsif ($type == BGP_TYPE_NOTIFICATION) { 474 | print "BGP PACKET TYPE: NOTIFICATION\n"; 475 | my ($error, $suberror, $data) = unpack('C C a*', $data); 476 | print "BGP PACKET TYPE: ERROR $error (subcode $suberror)\n"; 477 | } elsif ($type == BGP_TYPE_KEEPALIVE) { 478 | print "BGP PACKET TYPE: KEEPALIVE\n"; 479 | } else { die } 480 | } 481 | 482 | sub parse_nlri_prefixes { 483 | my ($nlri, $afi) = @_; 484 | $afi ||= AFI_IP; 485 | 486 | my @prefixes; 487 | while ($nlri and length $nlri > 0) { 488 | my ($len, $prefix); 489 | ($len, $nlri) = unpack('C a*', $nlri); 490 | my $bytes = int($len / 8) + ($len % 8 ? 1 : 0); 491 | ($prefix, $nlri) = unpack("a$bytes a*", $nlri); 492 | $prefix .= "\0" x (($afi == AFI_IP ? 4 : 16) - $bytes); # pad with NULs 493 | push(@prefixes, inet_ntop($afi, $prefix) . "/$len"); 494 | } 495 | return @prefixes; 496 | } 497 | 498 | sub print_verbose_attributes { 499 | my ($attr) = @_; 500 | 501 | print 'ORIGIN: ' . $BGP_ORIGIN[$attr->[BGP_ATTR_ORIGIN]] . "\n" 502 | if defined $attr->[BGP_ATTR_ORIGIN]; 503 | print 'AS_PATH:' . print_aspath($attr->[BGP_ATTR_AS_PATH]) . "\n" 504 | if $attr->[BGP_ATTR_AS_PATH]; 505 | print 'NEXT_HOP: ' . inet_ntoa($attr->[BGP_ATTR_NEXT_HOP])."\n" 506 | if notnull($attr->[BGP_ATTR_NEXT_HOP]); 507 | print 'MULTI_EXIT_DISC: ' . unpack('N', $attr->[BGP_ATTR_MULTI_EXIT_DISC]) 508 | . "\n" if $attr->[BGP_ATTR_MULTI_EXIT_DISC]; 509 | print "ATOMIC_AGGREGATE\n" if $attr->[BGP_ATTR_ATOMIC_AGGREGATE]; 510 | print 'AGGREGATOR: ' . unpack('n', ${$attr->[BGP_ATTR_AGGREGATOR]}[0]) 511 | . ' ' . inet_ntoa(${$attr->[BGP_ATTR_AGGREGATOR]}[1]) . "\n" 512 | if $attr->[BGP_ATTR_AGGREGATOR]; 513 | print 'ORIGINATOR_ID: ' . inet_ntoa($attr->[BGP_ATTR_ORIGINATOR_ID])."\n" 514 | if notnull($attr->[BGP_ATTR_ORIGINATOR_ID]); 515 | print 'CLUSTER_LIST: ' . inet_ntoa($attr->[BGP_ATTR_CLUSTER_LIST])."\n" 516 | if notnull($attr->[BGP_ATTR_CLUSTER_LIST]); 517 | print "COMMUNITIES: " 518 | . print_communities(@{$attr->[BGP_ATTR_COMMUNITIES]}) . "\n" 519 | if $attr->[BGP_ATTR_COMMUNITIES]; 520 | } 521 | 522 | sub print_communities { 523 | my @communities; 524 | foreach my $community (@_) { 525 | my ($hi, $low) = unpack('n n', $community); 526 | push(@communities, "${hi}:${low}"); 527 | } 528 | 529 | return join(' ', @communities); 530 | } 531 | 532 | sub pretty_as { 533 | my ($as_hi, $as_lo) = unpack('nn', $_[0]); 534 | return defined $as_lo ? ($as_hi ? unpack('N', $_[0]) : $as_lo) : $as_hi; 535 | } 536 | 537 | sub print_aspath { 538 | my ($aspath) = @_; 539 | 540 | my $s = ''; 541 | foreach (@$aspath) { 542 | # 1 AS_SET 2 AS_SEQUENCE 3 AS_CONFED_SEQUENCE 4 AS_CONFED_SET 543 | my ($type, $segment) = @$_; 544 | my $s1 = $type == AS_SET ? '{' : ''; 545 | my $s2 = $type == AS_SET ? '}' : ''; 546 | my $s3 = $type == AS_SET ? ',' : ' '; 547 | $s .= " $s1" . join($s3, map { pretty_as($_) } @$segment) . $s2; 548 | } 549 | return $s; 550 | } 551 | 552 | sub origin_as { 553 | my ($aspath) = @_; 554 | 555 | # BEWARE: in presence of an AS_SET the first AS of the set is returned 556 | return pop @{ @{pop @{$aspath}}[1] }; 557 | } 558 | 559 | sub notnull { 560 | return 1 if $_[0] and $_[0] ne "\0\0\0\0"; 561 | return 0; 562 | } 563 | 564 | sub inet_ntop { 565 | my ($af, $addr) = @_; 566 | 567 | if ($af == AFI_IP) { 568 | return inet_ntoa($addr); 569 | } elsif ($af == AFI_IP6) { 570 | return inet6_ntoa($addr); 571 | } else { die } 572 | } 573 | 574 | sub inet_ntoa { 575 | join('.', unpack('C4', $_[0])); 576 | } 577 | 578 | sub inet6_ntoa { 579 | local $_ = sprintf("%0*v2x", ':', $_[0]); 580 | s/(..):(..)/${1}${2}/g; 581 | s/(:0000)+$/::/; 582 | return '::' if $_ eq '0000::'; 583 | return $_; 584 | } 585 | 586 | sub hexdump { 587 | local $_ = sprintf("%0*v2X", ' ', $_[0]); 588 | s/((?:.. ){16})/${1}\n /g; 589 | s/((?:.. ){8})/${1} /g; 590 | print " $_\n"; 591 | } 592 | 593 | --------------------------------------------------------------------------------