#### ASpath-tree v.4.2 - Released on Thu APR 17 2003, h.16:58:12
#### File: lib/utility.pl Last modified on Thu APR 17 2003, h.16:55:44

@day   = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
@month = ("JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC");

# Routine to set the current runtime (global vars. CURRENTTIME, LONGDATE)
# Time format for LONGDATE: Mon MAY 13 1997, h.17:00
sub set_runtime {

	$CURRENTTIME = $^T;
	$LONGDATE = &convert_date($CURRENTTIME);
	return(0);
}

# Routine to log the current runtime and learn previous runtime (global var. LASTRUN)
# using/updating information stored in LASTRUNFILE
sub log_runtime {

	if (open(TFILE,"<".$LASTRUNFILE)) {
		$LASTRUN = <TFILE>;
		close(TFILE);
	}
	else {$LASTRUN = $CURRENTTIME}
	open(TFILE, ">".$LASTRUNFILE);
	print TFILE "$CURRENTTIME\n";
	close(TFILE);
	return(0);
}

# Routine to convert time in seconds from 1/1/1970 0:0:0 into format: Mon MAY 13 1997, h.17:00
sub convert_date {
	my ($seconds) = @_;
	my ($string,$sec,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

	($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($seconds);
	$year += 1900;
	$hour = ("0" x (2-length($hour))) . $hour;
	$min = ("0" x (2-length($min))) . $min;
	$string = "$day[$wday] $month[$mon] $mday $year, h.$hour:$min";
}

# Routine to convert time intervals in seconds into string format: "days hours mins"/"Change".
sub convert_sincelastchange_time {
	my ($seconds) = @_;
	my ($days, $hours, $minutes, $output, $text) = ('', '', '', '', '');

	$days = int($seconds/86400);
	$seconds = $seconds % 86400;
	$hours = int($seconds/3600);
	$seconds = $seconds % 3600;
	$minutes = int($seconds/60);

	if ($days) {
		$text = 'day';
		if ($days > 1) {$text = 'days'}
		$output = sprintf("%2s $text",$days);
	}
	if ($days || $hours) {
		$text = 'hour';
		if ($days > 1) {$text = 'hours'}
		$output .= sprintf("%3s $text",$hours);
	}
	if ($days || $hours || $minutes) {
		$text = 'min';
		$output .= sprintf("%3s $text",$minutes);
	}
	unless ($output) {$output = 'Change'}

	return($output);
}

# Routine to format number with N=$digits decimal figures
sub trunc_number {
	my ($num, $digits) = @_;
	my ($power) = (10**$digits);

	$num = $num*$power;
	$num = int($num + 0.5);
	$len = length($num);
	$num1 = substr($num, 0, $len-$digits);
	unless ($num1) {$num1 = "0"}
	unless ($digits == 0) {
		$num2 = substr($num, $len-$digits, 2);
		$num2 = ("0" x ($digits-length($num2))).$num2;
		$num = "$num1.$num2";
	} else {$num == $num1}
	return($num);
}

# Routine to format printable origin AS
sub format_originAS {
	my ($asnumber) = @_;
	my ($asname, $text) = ('', '');

	if ($asnumber eq 'local') {$text = $asnumber}
	else {
		$asname = $ASNAME{$asnumber};
		if ($ASNAME{$asnumber} =~ /^\{.*/) {$text = $asname}
		else {
			if ($asname =~ /\-/) {$text = "<NOBR>"}
			$text .= "<A HREF=\"$RIPEWHOISLINK+AS$asnumber\&do_search=Search\">".$asname."</A>";
		}
	}
	return($text);
}

# Routine to format printable AS name (not for trees)
sub format_asname {
	my ($asnumber) = @_;
	my $text = '';

	if (!defined($ASNAME{$asnumber})) {$text = 'AS'.$as}
	elsif ($ASNAME{$asnumber} !~ /^AS\d+$/) {$text = substr($ASNAME{$asnumber}, 0, 11)}
	else {$text = $ASNAME{$asnumber}}
	$text =~ s/\-/\&nbsp\;/g;
	return($text)
}

# routine to format printable owner ($flag = 1 -> use RIPE whois db)
sub format_owner {
	my ($owner, $flag) = @_;
	my $text = '';
	my ($whoislink, $trailer);

	if ($flag == 1) {
		$whoislink = $RIPEWHOISLINK."+";
		$trailer = '&do_search=Search';
	} else {
		$whoislink = $WHOISLINK."?";
		$trailer = '';
	}

	if ($owner eq '?' || $owner eq '-') {$text = $owner}
	else {
		if ($owner =~ /\-/) {$text = "<NOBR>"}
		$text .= "<A HREF=\"$whoislink$owner$trailer\">$owner</A>";
	}
	return($text);
}

# Routine to find the owner site name of a prefix
sub extract_name_from_prefix {
	my ($prefix) = @_;

	my ($line, $sitename) = ('', '');

	open(FILE,"<".$IPV6PREFIXTABLE);
	($line) = (grep(/$prefix/, <FILE>));
	close(FILE);

	$line =~ /^(\S+)\s+.*/;
	$sitename = $1;
	unless ($sitename) {$sitename = '?'}
	return($sitename);
}

# Routine to find a pTLA or sTLA owner from a generic prefix
sub extract_xtla_from_prefix {
	my ($prefix) = @_;

	my $xtla_found = '';

	if (includedprefix($prefix, "3FFE::/16")) {
		foreach my $ptla (keys(%PTLAS)) {
			if (includedprefix($prefix, $ptla)) {
				$xtla_found = $PTLAS{$ptla};
				last;
			}
		}
		unless ($xtla_found) {$xtla_found = '?'}
	} elsif (includedprefix($prefix, "2001::/16")) {
		foreach my $stla (keys(%STLAS)) {
			if (includedprefix($prefix, $stla)) {
				$xtla_found = $STLAS{$stla};
				last;
			}
		}
		unless ($xtla_found) {$xtla_found = '?'}
	}
	else {$xtla_found = '?'}
	return($xtla_found);
}

# Routine to update local copies of Internet whois DBs and format tables
# input = <void> -> check for newer versions of local db files
# input = 1 -> update from the Internet
# input = 2 -> recover dbs from backup
sub update_localdbs_tables {
	my ($input) = @_;
	my ($ipref, $ias, $istla, $site, $asnum, $prefix);
	my ($do_info_update, $do_info_restore, $do_pref, $do_ptla, $do_stla, $do_as, $do_SIXBONEdbconversion, $do_RIRsdbconversion) = (0, 0, 0, 0, 0, 0, 0, 0);
	my ($time_pref, $time_ptla, $time_stla, $time_as) = (0, 0, 0, 0);

	my @asn_nonassoc = ();

	&log_it("UPDATING DBs AND TABLEs...",1);

	if ($input == 1) {$do_info_update = 1}
	elsif ($input == 2) {$do_info_restore = 1}
	elsif ($input) {&log_it("  WARNING: update_localdbs_tables has unexpected input=$input\n")}
	else {
		unless (-e $SIXBONEDB || -e $RIRSDB) {
			&log_it("  WARNING: (update_localdbs_tables) $SIXBONEDB and $RIRSDB do not exist!\n");
		}
		if (-e $IPV6PREFIXTABLE) {$time_pref = (stat("$IPV6PREFIXTABLE"))[9]}
		if (-e $PTLA_FILE)       {$time_ptla = (stat("$PTLA_FILE"))[9]}
		if (-e $STLA_FILE)       {$time_stla = (stat("$STLA_FILE"))[9]}
		if (-e $ASTABLE)	 {$time_as   = (stat("$ASTABLE"))[9]}

		if (-e $SIXBONEDB) {
			if ((stat("$SIXBONEDB"))[9] > $time_pref) {$do_pref = 1}
			if ((stat("$SIXBONEDB"))[9] > $time_ptla) {$do_ptla = 1}
			if ((stat("$SIXBONEDB"))[9] > $time_as) {$do_as = 1}
		}
		if (-e $RIRSDB) {
			if ((stat("$RIRSDB"))[9] > $time_pref) {$do_pref = 1}
			if ((stat("$RIRSDB"))[9] > $time_stla) {$do_stla = 1}
			if ((stat("$RIRSDB"))[9] > $time_as) {$do_as = 1}
		}
		if (-e $ASFORCETABLE && (stat("$ASFORCETABLE"))[9] > $time_as) {$do_as = 1}
	}
	$do_SIXBONEdbconversion = $do_info_update || $do_pref || $do_as || $do_ptla;
	$do_RIRsdbconversion = $do_pref || $do_as || $do_stla;

	if ($do_info_update) {
		&log_it("  Updating the local information bases with whois queries over the Internet.",1);
		&log_it_and_die("  ERROR in configuration file: parameter RIPEWHOISCLIENT refers to a not executable file!") unless (-x $RIPEWHOISCLIENT);
		&backup_dbs_inuse;
# query 6Bone whois db (3ffe allocations)
		&SIXBONE_whois_query;
	} elsif ($do_info_restore) {
		&log_it("  Recovering previously used local information bases.",1);
		&restore_backup_dbs;
	}

# get sitename<->prefixes and AS number<->names associations
	if ($do_SIXBONEdbconversion) {($ipref, $ias) = &SIXBONEdbconversion}

	if ($do_info_update) {
# ovverride AS numbers<->names association got from whois DBs (update info case)
		$ias = &force_asinfo($ias);
# get AS numbers with no name association within the 6Bone DB
		@asn_nonassoc = &get_notassoc_asn(keys(%$ias));
# query the RIPE whois db (2001 allocations and spare AS number details)
		&RIRs_whois_query(\@asn_nonassoc);
	}

# get sitename<->prefixes, AS number<->names, sTLA<->organization  associations
	if ($do_RIRsdbconversion) {($ipref, $ias, $istla) = &RIRsdbconversion($ipref, $ias)}

# ovverride AS numbers<->names association got from whois DBs (other cases)
	if ($do_as) {$ias = &force_asinfo($ias)}

	if ($do_pref) {
# write ipv6_prefix table
		open(FILE,">".$IPV6PREFIXTABLE);
		printf FILE ("%-35s %-50s\n", 'Sitename', 'Prefixes');
		printf FILE ("%-35s %-50s\n", '-----------------------------------', '----------------------------------------------');
		foreach $site (sort (keys(%$ipref))) {
			if ($$ipref{$site} =~ /\S+/) {printf FILE ("%-35s %-50s\n", $site, $$ipref{$site})}
		}
		close(FILE);
		&log_it("  New $IPV6PREFIXTABLE created",1);
	}
	if ($do_ptla) {
# write ptla-prefixes table
		my %ptla = ();
		foreach $site (keys(%$ipref)) {
			my @prefixes = (grep(/\S/, split(/\s+/, $$ipref{$site})));
			foreach $prefix (@prefixes) {if (&check_prefix($prefix) == 1) {$ptla{$prefix} = $site}}
		}
		open(FILE,">".$PTLA_FILE);
		printf FILE ("%-35s %-50s\n", 'pTLA owner', 'pTLA Prefix');
		printf FILE ("%-35s %-50s\n", '-----------------------------------', '----------------------------------------------');
		foreach $prefix (sort(keys(%ptla))) {
			printf FILE ("%-35s %-50s\n", $ptla{$prefix}, $prefix);
		}
		close(FILE);
		&log_it("  New $PTLA_FILE created",1);
	}
	if ($do_stla) {
# write stla-prefixes table
		open(FILE,">".$STLA_FILE);
		printf FILE ("%-35s %-50s\n", 'sTLA owner', 'sTLA Prefix');
		printf FILE ("%-35s %-50s\n", '-----------------------------------', '----------------------------------------------');
		foreach $site (sort {$$istla{$a} cmp $$istla{$b}} (keys(%$istla))) {
			printf FILE ("%-35s %-50s\n", $site, $$istla{$site});
		}
		close(FILE);
		&log_it("  New $STLA_FILE created",1);
	}
	if ($do_as) {
# write AS table
		open(FILE,">".$ASTABLE);
		printf FILE ("%-10s %-50s\n", 'AS number', 'Associated Names'); printf FILE ("%-10s %-50s\n", '----------', '-----------------------------------------------------------------------');
		foreach $asnum (sort {$a <=> $b} (keys(%$ias))) {
			printf FILE ("%-10s %-50s\n", "AS".$asnum, $$ias{$asnum});
		}
		close(FILE);
		&log_it("  New $ASTABLE created",1);
	}
	&log_it("  Done!",1);
	return(0);
}

# backup *.db files
sub backup_dbs_inuse {

	$SIXBONEDB =~ m!([^/]*)$!;
	my $sixbonedb_fname = $1;
	$RIRSDB =~ m!([^/]*)$!;
	my $rirsdb_fname = $1;

	unless (-e "$DATADIR/prev") {mkdir("$DATADIR/prev", 0777); &log_it("$DATADIR/prev created.")}
	if (-e "$SIXBONEDB") {
		system "mv $SIXBONEDB $DATADIR/prev/$sixbonedb_fname\.backup";
		&log_it("  New backup file $DATADIR/prev/$sixbonedb_fname\.backup created.",1);
	} else {&log_it("Backup failed (non existing $SIXBONEDB).",1)}
	if (-e "$RIRSDB") {
		system "mv $RIRSDB $DATADIR/prev/$rirsdb_fname\.backup";
		&log_it("  New backup file $DATADIR/prev/$rirsdb_fname\.backup created.",1);
	} else {&log_it("Backup failed (non existing $RIRSDB).",1)}
	return(0);
}

# Routine to restore backup *.db files
sub restore_backup_dbs {

	$SIXBONEDB =~ m!([^/]*)$!;
	my $sixbonedb_fname = $1;
	$RIRSDB =~ m!([^/]*)$!;
	my $rirsdb_fname = $1;

	if (-e "$DATADIR/prev/$sixbonedb_fname.backup") {
		system "cp $DATADIR/prev/$sixbonedb_fname\.backup $SIXBONEDB\.backup";
		if (-e "$SIXBONEDB") {system "mv $SIXBONEDB $DATADIR/prev/$sixbonedb_fname\.backup"}
		else {system "rm $DATADIR/prev/$sixbonedb_fname\.backup"}
		system "mv $SIXBONEDB\.backup $SIXBONEDB";
		&log_it("  Prev db file \"$sixbonedb_fname\" recovered.",1);
	} else {&log_it("  Recovery failed (file $DATADIR/prev/$sixbonedb_fname\.backup not found).",1)}
	if (-e "$DATADIR/prev/$rirsdb_fname.backup") {
		system "cp $DATADIR/prev/$rirsdb_fname\.backup $RIRSDB\.backup";
		if (-e "$RIRSDB") {system "mv $RIRSDB $DATADIR/prev/$rirsdb_fname\.backup"}
		else {system "rm $DATADIR/prev/$rirsdb_fname\.backup"}
		system "mv $RIRSDB\.backup $RIRSDB";
		&log_it("  Prev db file \"$rirsdb_fname\" recovered.",1);
	} else {&log_it("  Recovery failed (file $DATADIR/prev/$rirsdb_fname\.backup not found).",1)}
	return(0);
}

# Routine to query the 6Bone whois db
sub SIXBONE_whois_query {

	my @outwhois = ();
	my $command = "-h whois.6bone.net -r -T inet6num,ipv6-site -M 3ffe::/16";

	open(WHOISRES,"$RIPEWHOISCLIENT $command |");
	@outwhois = <WHOISRES>;
	close(WHOISRES);

	@outwhois = grep(!/^\%/, @outwhois);

	open(FILE,"> $SIXBONEDB.tmp");
	foreach (@outwhois) {print FILE $_}
	close(FILE);

	system "mv $SIXBONEDB.tmp $SIXBONEDB";
	&log_it("  File $SIXBONEDB created from the output of:\n  $RIPEWHOISCLIENT $command",1);
	return(0);
}

# Routine to query RIRs' whois DBs through RIPE (IPv6 allocations and non associated AS numbers)
sub RIRs_whois_query {
	my ($iasns) = @_;
	my $asn;
	my @outwhois = ();
	my @coomands = ();

	my $command = "-h whois.ripe.net -s ARIN,RIPE,APNIC -r -T inet6num -M 2001::/16";
	push (@commands, $command);

	open(WHOISRES,"$RIPEWHOISCLIENT $command |");
	@outwhois = <WHOISRES>;
	close(WHOISRES);

	@outwhois = grep(!/^\%/, @outwhois);

	open(FILE,"> $RIRSDB.tmp");
	foreach (@outwhois) {print FILE $_}

	foreach $asn (@$iasns) {
		@outwhois = ();
		$command = "-h whois.ripe.net -s ARIN,RIPE,APNIC -r -T aut-num AS".$asn;
		push (@commands, $command);
		open(WHOISRES,"$RIPEWHOISCLIENT $command |");
		@outwhois = <WHOISRES>;
		close(WHOISRES);
		@outwhois = grep(!/^\%/, @outwhois);
		foreach (@outwhois) {print FILE $_}
	}
	close(FILE);

	system "mv $RIRSDB.tmp $RIRSDB";
	&log_it("  File $RIRSDB created from the output of:",1);
	foreach $command (@commands) {&log_it("   $RIPEWHOISCLIENT $command",1)}
	return(0);
}

# Routine to extract needed information from the 6Bone registry
sub SIXBONEdbconversion {
	my $state = 0;
	my ($db_line, $site, $extracted_prefix, $inet6_prefix, $prefix, $tmp_string, $asnum) = ('', '', '', '', '', '', '');
	my @prefixes = ();
	my @lines = ();
	my (%as_assoc, %address, %ptla);

	open(DB,"<".$SIXBONEDB) or die "Can't open $SIXBONEDB: $!\n";

	while (<DB>) {
		$db_line = $_;
		chomp($db_line);
		if ($state == 0) {
			if (grep(/^ipv6-site:/,$db_line)) {
				$db_line =~ /^ipv6-site:\s+(\S+)/;
				$site = $1;
				$state = 1;
			}
			if (grep(/^inet6num:/,$db_line)) {
				$db_line =~ /^inet6num:\s+(\S+)/;
				$inet6_prefix = &normal($1);
				$state = 2;
			}
		} elsif ($state == 1) {
			if (grep(/^origin:/,$db_line)) {
				$db_line =~ /^origin:\D+(\d+)/;
				$asnum = $1;
				unless (grep(/$site/, $as_assoc{$asnum})) {$as_assoc{$asnum} .= $site." "}
			} elsif (grep(/^prefix:/,$db_line)) {
				$db_line =~ /^prefix:\s+(\S+)/;
				$extracted_prefix = &normal($1);
				unless (grep(/$extracted_prefix/, $address{$site}) || &includedprefix($extracted_prefix,"3ffe::/16") == 0) {$address{$site} .= $extracted_prefix." "}
			} elsif (!$db_line) {$state = 0}
		} elsif ($state == 2) {
			if (grep(/^netname:/,$db_line)) {
				$db_line =~ /^netname:\s+(\S+)/;
				$site = $1;
				unless (grep(/$inet6_prefix/, $address{$site}) || &includedprefix($inet6_prefix,"3ffe::/16") == 0) {$address{$site} .= $inet6_prefix." "}
			} elsif (!$db_line) {$state = 0}
		}
	}
	close(DB);

	return(\%address, \%as_assoc);
}

# Routine to extract needed information from the RIRs whois query's results
sub RIRsdbconversion {
	my ($iaddress, $iasnames) = @_;
	my $state = 0;
	my ($db_line, $site, $inet6_prefix, $name, $asnumber, $num, $len) = ('', '', '', '', '', '', '');
	my (%stla);

	open(DB,"<".$RIRSDB) or die "Can't open $RIRSDB: $!\n";

	while (<DB>) {
		$db_line = $_;
		chomp($db_line);

		if ($state == 0) {
			if ($db_line =~ /^inet6num:\s+(\S+)/) {
				$inet6_prefix = &normal($1);
				$state = 1;
			} elsif ($db_line =~ /^aut-num:\s+AS(\d+)/) {
				$asnumber = $1;
				$state = 2;
			}
		}
		elsif ($state == 1) {
			if ($db_line =~ /^netname:\s+(\S+)/) {
				$site = $1;
				unless (grep(/$inet6_prefix/, $$iaddress{$site})) {$$iaddress{$site} .= $inet6_prefix." "}
			} elsif ($db_line =~ /^status:\s+(\S+.*)/) {
				$status = $1;
				($num, $len) = split(/\//, $inet6_prefix);
				if (($status =~ /^ALLOCATED-BY-RIR/
				    || $status =~ /^ALLOCATED\s+PORTABLE/
				    ) && $len >= 29
				   ) {$stla{$site} = $inet6_prefix}

			} elsif (!$db_line) {
				$state = 0;
			}
		} elsif ($state == 2) {
			if ($db_line =~ /^as-name:\s+(\S+)\s*\#?.*/) {
				$name = $1;
#				unless ($name =~ /^UNSPECIFIED\s*/) {$$iasnames{$asnumber} = $name}
				unless (grep(/^$asnumber$/,keys(%$iasnames)) || $name =~ /^UNSPECIFIED\s*/) {$$iasnames{$asnumber} = $name}
			} elsif (!$db_line) {$state = 0}
		}
	}
	close(DB);

	return($iaddress, $iasnames, \%stla);
}

# Routine to get AS numbers in trees not associated with names
sub get_notassoc_asn {
	my (@ASnumbers_assoc) = @_;

	my ($aspath, $line, $asn, $asn1) = ('', '', '', '');
	my @asn_inpath = ();
	my @asn_inset = ();
	my @lines = ();
	my @ASnumbers_intree = ();
	my @ASnumbers = ();

	my @history = &read_history($HISTORYFILE);
	foreach $line (@history) {
		if ($line =~ /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)\s*\n/) {$aspath = $4}
		@asn_inpath = split(/\//,$aspath);
		foreach $asn (@asn_inpath) {
			if ($asn =~ /\#+/) {
				@asn_inset = split(/\#/,$asn);
				foreach $asn1 (@asn_inset) {unless(grep(/^$asn1$/, @ASnumbers_intree)) {push(@ASnumbers_intree, $asn1)}}
			} elsif (!grep(/^$asn$/, @ASnumbers_intree)) {push(@ASnumbers_intree, $asn)}
		}
	}

	foreach $asn (@ASnumbers_intree) {unless(grep(/^$asn$/,@ASnumbers_assoc)) {push(@ASnumbers, $asn)}}

	return(@ASnumbers);
}

# Routine to include custom associations to AS numbers
sub force_asinfo {
	my ($ias) = @_;
	my @lines = ();
	my ($line);

	if (-e $ASFORCETABLE) {
		open(FILE, "< $ASFORCETABLE");
		@lines = <FILE>;
		close(FILE);
		foreach $line (@lines) {if ($line =~ /^A?S?(\d+)\s+(.+)/) {$$ias{$1} = $2}}
	}
	return($ias);
}

# Routine to associate the name of the owner organisation to an AS number
sub asntosite {
	my ($ASN, $astable, $ptlastable) = @_;
	my (@aslines, @bb_sites, @output, @tmp);
	my ($key, $line, $name, $nbb);

	require("$LIB/ipv6prefix.pl");

	open(ASS,"<".$astable);
	@aslines = <ASS>;
	close(ASS);

	open(BACKBONE,"<".$ptlastable);
	@bb_sites = <BACKBONE>;
	close(BACKBONE);

	@output = ();

	$key = 'AS'.$ASN;
	($line) = grep(/^$key\s+.*/,@aslines);
	$nbb = 0;
	if ($line =~ /^$key\s+(\S+.*)/) {
		@tmp = split(/\s+/, $1);
		foreach $name (@tmp) {
			if (grep(/$name/, @bb_sites)) {
				$nbb++;
				unshift(@output, $name);
			} else {push(@output, $name)}
		}
		return(($nbb,@output));
	}
	else {return((-1,()))}
}

(1);
#### ASpath-tree v.4.2 - Released on Thu APR 17 2003, h.16:58:12
#### File: lib/utility.pl Last modified on Thu APR 17 2003, h.16:55:44