#!/usr/local/bin/perl

%mon = ('Jan' => '01', 'Feb' => '02', 'Mar' => '03', 'Apr' => '04',
        'May' => '05', 'Jun' => '06', 'Jul' => '07', 'Aug' => '08',
	'Sep' => '09', 'Oct' => '10', 'Nov' => '11', 'Dec' => '12');

@output_order = ("6bone", "6to4", "autoconf", "global", "link-local",
	"loopback", "privacy?", "teredo", "ISATAP", "v4based?",
	"v4hits", "v4ips", "AfriNIC", "APNIC", "ARIN", "LACNIC",
	"RIPE", "autother", "autoffff", "low", "wordy",
	"random", "ULA", "doc");

#
# These are a list of the /8s that are either reserved, localhost
# or multicast based on
# http://www.iana.org/assignments/ipv4-address-space most recently
# and ipv4-address-space2pl.pl
#

%IANAreservedV4 = (
  0 => 1,   1 => 1,   2 => 1,   5 => 1,   7 => 1,  23 => 1,  27 => 1,  31 => 1, 
 36 => 1,  37 => 1,  39 => 1,  42 => 1,  46 => 1,  49 => 1,  50 => 1, 100 => 1, 
101 => 1, 102 => 1, 103 => 1, 104 => 1, 105 => 1, 106 => 1, 107 => 1, 108 => 1, 
109 => 1, 110 => 1, 111 => 1, 112 => 1, 113 => 1, 114 => 1, 115 => 1, 127 => 1, 
173 => 1, 174 => 1, 175 => 1, 176 => 1, 177 => 1, 178 => 1, 179 => 1, 180 => 1, 
181 => 1, 182 => 1, 183 => 1, 184 => 1, 185 => 1, 186 => 1, 187 => 1, 197 => 1, 
223 => 1, 224 => 1, 225 => 1, 226 => 1, 227 => 1, 228 => 1, 229 => 1, 230 => 1, 
231 => 1, 232 => 1, 233 => 1, 234 => 1, 235 => 1, 236 => 1, 237 => 1, 238 => 1, 
239 => 1, 240 => 1, 241 => 1, 242 => 1, 243 => 1, 244 => 1, 245 => 1, 246 => 1, 
247 => 1, 248 => 1, 249 => 1, 250 => 1, 251 => 1, 252 => 1, 253 => 1, 254 => 1, 
255 => 1, 
);

#
# Some words that people might be tempted to use in addresses
#
%countwords_words = (
"00ad" => 1, "00ba" => 1, "00be" => 1, "00d0" => 1, "00da" => 1,
"00ed" => 1, "0ace" => 1, "0ada" => 1, "0add" => 1, "0ade" => 1,
"0b00" => 1, "0b0a" => 1, "0b0b" => 1, "0baa" => 1, "0bad" => 1,
"0bea" => 1, "0bed" => 1, "0bee" => 1, "0c00" => 1, "0c0b" => 1,
"0c0d" => 1, "0cab" => 1, "0d0b" => 1, "0d0c" => 1, "0d0d" => 1,
"0d0e" => 1, "0dab" => 1, "0dad" => 1, "0deb" => 1, "0dee" => 1,
"0ebb" => 1, "0f00" => 1, "0f0b" => 1, "0f0d" => 1, "0f0e" => 1,
"0fad" => 1, "0fae" => 1, "0fed" => 1, "0fee" => 1, "abba" => 1,
"b00b" => 1, "b0b0" => 1, "b0de" => 1, "baba" => 1, "babe" => 1,
"bade" => 1, "baff" => 1, "bead" => 1, "beef" => 1, "c0c0" => 1,
"c0ca" => 1, "c0d0" => 1, "c0da" => 1, "c0de" => 1, "c0ed" => 1,
"c0ff" => 1, "cafe" => 1, "cede" => 1, "d00b" => 1, "d0d0" => 1,
"d0de" => 1, "dada" => 1, "dead" => 1, "deaf" => 1, "deed" => 1,
"f00d" => 1, "f0ad" => 1, "face" => 1, "fade" => 1, "faff" => 1,
"feed" => 1, "1337" => 1, "0000" => 1, "1111" => 1, "2222" => 1,
"3333" => 1, "4444" => 1, "5555" => 1, "6666" => 1, "7777" => 1,
"8888" => 1, "9999" => 1, "aaaa" => 1, "bbbb" => 1, "cccc" => 1,
"dddd" => 1, "eeee" => 1, "ffff" => 1, "00ff" => 1, "abab" => 1,
);


require "v4summary_generic.pl";

while (<>) {
	($addr, $m, $y) = m#^([0-9a-fA-F:.]*) [^[]*\[\d\d/(\w\w\w)/(\d\d\d\d).*\]#;

	$m = $mon{$m};
	$date = "$y-$m";
	unless ($addr =~ /:/) { $badlines++; warn "Bad line $_"; next; }

	$seen{$date} = 1;
	$hits{$date}->{$addr}++;
	if ($hits{$date}->{$addr} == 1) {
		foreach $attr (&classify($addr)) {
			$hita{$date}->{$attr}++;
			$attrlist{$attr}++;
		}
	}
}

#
# Transcribe results from the v4 summary.
#
foreach $date (sort keys %v4hits) {
	$seen{$date} = 1;
	$hita{$date}->{"v4hits"} = $v4hits{$date} if (defined($v4hits{$date}));
	$hita{$date}->{"v4ips"} = $v4ips{$date} if (defined($v4ips{$date}));
}

#
# Print header.
#
print "#1\t2\t3\t";
$field = 4;
undef %printed;
foreach $attr (@output_order) { print $field++ ,"\t"; $printed{$attr} = 1;}
foreach $attr (sort keys %attrlist) { next if ($printed{$attr}); print $field++,"\t"; }
print "\n";
print "#date\thits\taddrs\t";
undef %printed;
foreach $attr (@output_order) { print substr($attr,0,7),"\t"; $printed{$attr} = 1;}
foreach $attr (sort keys %attrlist) { next if ($printed{$attr}); print substr($attr,0,7),"\t"; }
print "\n";

#
# Print results.
#
foreach $date (sort keys %seen) {
	open(S, ">results/$date") || warn "Couldn't open results/$date";
	$tot = 0;
	$ads = 0;
	foreach $addr (sort keys %{$hits{$date}}) {
		print S $addr, "\t", $hits{$date}->{$addr}, "\t",
		    join(" ", &classify($addr)), "\n";
		$tot += $hits{$date}->{$addr};
		$ads++;
	}
	close(S);
	undef %printed;
	print "$date\t$tot\t$ads\t";
	foreach $attr (@output_order) {
		print int($hita{$date}->{$attr}), "\t";
		$printed{$attr} = 1;
	}
	foreach $attr (sort keys %attrlist) {
		next if ($printed{$attr});
		print int($hita{$date}->{$attr}), "\t";
	}
	print "\n";
}

################################################################################

sub classify {
	my($addr) = shift;
	my($fulladdr, @groups, $setbits, $setbitsA, $setbitsB, $words);
	my(@attrs) = ();
	my ($dohostid);

	$fulladdr = &expandv6($addr);
	@groups = split(/:/, $fulladdr);

	$dohostid = 1;

	#
	# First classify the prefix.
	#
	if ($groups[0] eq "0000" && $groups[1] eq "0000" && $groups[2] eq "0000"
	    && $groups[3] eq "0000") {
		if ($groups[4] eq "0000" && $groups[5] eq "0000") {
	    		if ($groups[6] eq "0000") {
				if ($groups[7] eq "0000") {
					push @attrs, "unspecified";
					$dohostid = 0;
				} elsif ($groups[7] eq "0001") {
					push @attrs, "loopback";
					$dohostid = 0;
				}
			} else {
				push @attrs, "compatible";
				$dohostid = 0;
			}
		} elsif ($groups[4] eq "0000" && $groups[5] eq "ffff") {
			push @attrs, "mapped";
			$dohostid = 0;
		} else {
			warn "Unclassified prefix $addr";
		}
	} elsif ($groups[0] =~ /^0[23]/) {
		push @attrs, "OSINSAP";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[01]/) {
		if ($groups[1] eq "0000") {
			push @attrs, "teredo";
			$dohostid = 0;
		} elsif ($groups[1] =~ /^001/) {
			push @attrs, "orchid";
		} else {
			push @attrs, "IANA"; 	# 2001:0000::/23 (IANA)
		}
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[23]/) {
		push @attrs, "APNIC"; 	# 2001:0200::/23 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[45]/) {
		push @attrs, "ARIN"; 	# 2001:0400::/23 (ARIN)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[67]/) {
		push @attrs, "RIPE"; 	# 2001:0600::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[89]/) {
		push @attrs, "RIPE"; 	# 2001:0800::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[ab]/) {
		push @attrs, "RIPE"; 	# 2001:0A00::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[cd]/) {
		if ($groups[1] eq "0db8") {
			push @attrs, "doc";
		} else {
			push @attrs, "APNIC"; 	# 2001:0C00::/23 (APNIC)
			push @attrs, "global";
		}
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^0[ef]/) {
		push @attrs, "APNIC"; 	# 2001:0E00::/23 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^1[23]/) {
		push @attrs, "LACNIC"; 	# 2001:1200::/23 (LACNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^1[45]/) {
		push @attrs, "RIPE"; 	# 2001:1400::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^1[67]/) {
		push @attrs, "RIPE"; 	# 2001:1600::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^1[89]/) {
		push @attrs, "ARIN"; 	# 2001:1800::/23 (ARIN)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^1[ab]/) {
		push @attrs, "RIPE"; 	# 2001:1A00::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^1[cdef]/) {
		push @attrs, "RIPE"; 	# 2001:1C00::/22 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^2/) {
		push @attrs, "RIPE"; 	# 2001:2000::/20 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^3[01234567]/) {
		push @attrs, "RIPE"; 	# 2001:3000::/21 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^3[89ab]/) {
		push @attrs, "RIPE"; 	# 2001:3800::/22 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^3[cdef]/) {
		push @attrs, "RESERVED"; 	# 2001:3C00::/22 (RESERVED)
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[01]/) {
		push @attrs, "RIPE"; 	# 2001:4000::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[23]/) {
		push @attrs, "AfriNIC"; 	# 2001:4200::/23 (AfriNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[45]/) {
		push @attrs, "APNIC"; 	# 2001:4400::/23 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[67]/) {
		push @attrs, "RIPE"; 	# 2001:4600::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[89]/) {
		push @attrs, "ARIN"; 	# 2001:4800::/23 (ARIN)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[ab]/) {
		push @attrs, "RIPE"; 	# 2001:4A00::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^4[cd]/) {
		push @attrs, "RIPE"; 	# 2001:4C00::/23 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^5/) {
		push @attrs, "RIPE"; 	# 2001:5000::/20 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^[89]/) {
		push @attrs, "APNIC"; 	# 2001:8000::/19 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^a/) {
		push @attrs, "APNIC"; 	# 2001:A000::/20 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "2001" && $groups[1] =~ /^b/) {
		push @attrs, "APNIC"; 	# 2001:B000::/20 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] =~ /^2002/) {
		push @attrs, "6to4"; 	# 2002:0000::/16 (6to4)
	} elsif ($groups[0] eq "2003" && $groups[1] =~ /^[0123]/) {
		push @attrs, "RIPE"; 	# 2003:0000::/18 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] =~ /^240/) {
		push @attrs, "APNIC"; 	# 2400:0000::/12 (APNIC)
		push @attrs, "global";
	} elsif ($groups[0] =~ /^260/) {
		push @attrs, "ARIN"; 	# 2600:0000::/12 (ARIN)
		push @attrs, "global";
	} elsif ($groups[0] eq "2610" && $groups[1] =~ /^0[01]/) {
		push @attrs, "ARIN"; 	# 2610:0000::/23 (ARIN)
		push @attrs, "global";
	} elsif ($groups[0] eq "2620" && $groups[1] =~ /^0[01]/) {
		push @attrs, "ARIN"; 	# 2620:0000::/23 (ARIN)
		push @attrs, "global";
	} elsif ($groups[0] =~ /^280/) {
		push @attrs, "LACNIC"; 	# 2800:0000::/12 (LACNIC)
		push @attrs, "global";
	} elsif ($groups[0] =~ /^2a0/) {
		push @attrs, "RIPE"; 	# 2A00:0000::/12 (RIPE NCC)
		push @attrs, "global";
	} elsif ($groups[0] =~ /^2c0/) {
		push @attrs, "AfriNIC"; 	# 2C00:0000::/12 (AfriNIC)
		push @attrs, "global";
	} elsif ($groups[0] eq "3ffe") {
		push @attrs, "6bone";
		if ($groups[1] eq "831f") {
			push @attrs, "teredo";
			$dohostid = 0;
		}
	} elsif ($groups[0] =~ /^f[cd]/) {
		push @attrs, "ULA";
	} elsif ($groups[0] =~ /^fe[89ab]/) {
		push @attrs, "link-local";
	} elsif ($groups[0] eq /^fe[cdef]/) {
		push @attrs, "site-local";
	} elsif ($groups[0] eq /^ff/) {
		push @attrs, "multicast";
	} else {
		warn "Unclassified prefix $addr.\n";
	}


	#
	# Now work on the host ID.
	#
	goto DONE unless ($dohostid);
	$setbits = &countbits($groups[4],$groups[5],$groups[6],$groups[7]);
	$setbitsA = &countbits($groups[4],$groups[5]);
	$setbitsB = &countbits($groups[6],$groups[7]);
	$words = &countwords($groups[4],$groups[5],$groups[6],$groups[7]);

	if ($groups[4] =~ /0[02]00/ && $groups[5] eq "5efe") {
		push @attrs, "ISATAP";
	} elsif ($groups[4] =~ /^f[cf]ff/ && $groups[5] eq "ffff"
	    && $groups[6] eq "feff" && $groups[7] eq "ffff") {
		push @attrs, "autoffff";
	} elsif ($groups[4] =~ /^.[2367abef]/ && $groups[5] =~ /^..ff/
	    && $groups[6] =~ /^fe/) {
		push @attrs, "autoconf";
	} elsif ($groups[5] =~ /^..ff/ && $groups[6] =~ /^fe/) {
		push @attrs, "autother";
	} elsif ($groups[4] eq "0000" && $groups[5] eq "0000"
	    && $groups[6] eq "0000" && $groups[7] =~ /^00/) {
		push @attrs, "low";
	} elsif (($groups[0] eq "2002" && $groups[1] eq $groups[6])
	    || ($groups[4] eq "0000" && $groups[5] eq "0000"
	        && !&isv4reserved($groups[6]) && $groups[6] ne $groups[7])) {
		push @attrs, "v4based?";
	} elsif ($words == 4) {
		push @attrs, "wordy";
	} elsif ($groups[4] =~ /^.[014589cd]/
	      && $setbits >= 27 && $setbits <= 35
	      && $setbitsA >= 9 && $setbitsA < 21
	      && $setbitsB >= 10 && $setbitsB < 22
	      && $words < 2) {
		push @attrs, "privacy?";
	} elsif ($groups[4] =~ /^.[2367abef]/
	      && $setbits >= 28 && $setbits <= 36
	      && $setbitsA >= 10&& $setbitsA < 22
	      && $setbitsB >= 10 && $setbitsB < 22
	      && $words < 2) {
		push @attrs, "random";
	}

DONE:
	return @attrs;
}

sub expandv6 {
	local ($_) = @_;
	my (@parts, @newparts, $part);

	s/\s+//g; # Get rid of white space.
	s/%.*//g; # Get rid of KAME scope ID, if there is one.
	if (/:(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { # Expand trailing IPv4 address.
		$part = sprintf ":%02x%02x:%02x%02x", $1, $2, $3, $4;
		s/:\d+\.\d+\.\d+\.\d+$/$part/;
	}

	@parts = split(/:/, $_, -1);
	$short = 8 - $#parts;
	@newparts = ();

	foreach $part (@parts) {
		if ($part eq "" && $short > 0) {
			while ($short-- > 0) { push @newparts, "0000"; }
		} else {
			push @newparts, (sprintf "%04x", hex($part));
		}
	}

	return join ":", @newparts;
}

sub countbits {
	my(@parts) = @_;
	my($p, $v, $c);
	
	$c = 0;
	foreach $p ( @parts ) {
		$v = hex($p);
		while ($v != 0) {
			$v = $v & ($v - 1);
			$c++;
		}
	}

	return $c;
}


sub countwords {
	my(@parts) = @_;
	my($p, $v, $c);

	$c = 0;
	foreach $p ( @parts ) {
		$c += $countwords_words{$p};
	}

	return $c;
}

sub isv4reserved {
	my($group) = @_;

	return $IANAreservedV4{hex(substr($group, 0, 2))};
}