[or-cvs] r14662: incorporate updates to main blossom script following the Tor (blossom/trunk)
goodell at seul.org
goodell at seul.org
Mon May 19 04:20:02 UTC 2008
Author: goodell
Date: 2008-05-19 00:20:01 -0400 (Mon, 19 May 2008)
New Revision: 14662
Removed:
blossom/trunk/exit.pl
Modified:
blossom/trunk/blossom.pl
blossom/trunk/country-codes.txt
Log:
incorporate updates to main blossom script following the Tor SVN snapshot
Modified: blossom/trunk/blossom.pl
===================================================================
--- blossom/trunk/blossom.pl 2008-05-19 04:16:53 UTC (rev 14661)
+++ blossom/trunk/blossom.pl 2008-05-19 04:20:01 UTC (rev 14662)
@@ -1,5 +1,5 @@
#!/usr/bin/perl -w
-# $Id: blossom.pl,v 1.19 2006-03-20 23:19:33 goodell Exp $
+# $Id: blossom.pl,v 1.20 2006-08-19 21:34:03 goodell Exp $
$license = <<EOF
Copyright (c) 2005 Geoffrey Goodell.
@@ -24,7 +24,7 @@
# global configuration parameters
my $CACHE = "/var/cache/www-data";
-my $F_CCODES = "/afs/eecs.harvard.edu/user/goodell/misc/country-codes.txt";
+my $F_CCODES = "/afs/eecs.harvard.edu/user/goodell/public_html/country-codes.txt";
my $URL_FLAGS = "http://afs.eecs.harvard.edu/~goodell/flags";
my $URL_ICONS = "http://afs.eecs.harvard.edu/~goodell/icons";
my $URL_EXIT = "http://serifos.eecs.harvard.edu/cgi-bin/exit.pl";
Modified: blossom/trunk/country-codes.txt
===================================================================
--- blossom/trunk/country-codes.txt 2008-05-19 04:16:53 UTC (rev 14661)
+++ blossom/trunk/country-codes.txt 2008-05-19 04:20:01 UTC (rev 14662)
@@ -1,5 +1,6 @@
19 RFC 1918 Private
33 RFC 3330 Reserved
+~~ Unclassified
AD Andorra
AE United Arab Emirates
AF Afghanistan
@@ -66,6 +67,7 @@
ER Eritrea
ES Spain
ET Ethiopia
+EU European Union
FI Finland
FJ Fiji
FK Falkland Islands (Malvinas)
Deleted: blossom/trunk/exit.pl
===================================================================
--- blossom/trunk/exit.pl 2008-05-19 04:16:53 UTC (rev 14661)
+++ blossom/trunk/exit.pl 2008-05-19 04:20:01 UTC (rev 14662)
@@ -1,1231 +0,0 @@
-#!/usr/bin/perl -w
-# $Id: exit.pl,v 1.36 2006-07-06 01:35:47 goodell Exp $
-$license = <<EOF
-Copyright (c) 2005-2006 Geoffrey Goodell.
-
-This program is free software; you can redistribute it and/or modify it under
-the terms of version 2 of the GNU General Public License as published by the
-Free Software Foundation.
-
-This program is distributed in the hope that it will be useful, but WITHOUT ANY
-WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
-PARTICULAR PURPOSE. See the GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License along with
-this program; if not, write to the Free Software Foundation, Inc., 59 Temple
-Place - Suite 330, Boston, MA 02111-1307, USA.
-
-EOF
-;
-
-use strict;
-use Socket;
-
-# global configuration parameters
-
-my @portslist = (22, 53, 80, 110, 119, 143, 443, 5190, 6667);
-my @os_names = ("Cygwin",
- "Darwin",
- "DragonFly",
- "FreeBSD",
- "IRIX64",
- "Linux",
- "NetBSD",
- "OpenBSD",
- "SunOS",
- "Windows",
- "Unknown");
-
-my $CONFIG = "/etc/exit.conf";
-my $CACHE = "/var/cache/www-data";
-my $A_STANDARD = "standard";
-my $A_UNVERIFIED = "unverified";
-my $A_AUTHORITY = "failedstream";
-my $TD_DEFAULT = "td";
-my $TITLE = "Tor Network Status";
-my $URL_FLAGS = "http://afs.eecs.harvard.edu/~goodell/flags";
-my $URL_ICONS = "http://afs.eecs.harvard.edu/~goodell/icons";
-my $URL_OSICONS = "http://afs.eecs.harvard.edu/~goodell/os-icons";
-my $URL_SOURCE = "http://afs.eecs.harvard.edu/~goodell/blossom/src/exit.pl";
-my $URL_HOME = "http://tor.eff.org/";
-my $URL_DIRECTORY = "http://localhost:9030/tor/";
-my $URL_STATUS = "http://localhost:9030/tor/running-routers";
-my $URL_V2DIR = "http://localhost:9030/tor/status/all";
-my $URL_WHOIS = "http://alsatia.eecs.harvard.edu/cgi-bin/whois.pl\?q=";
-my $LINK_DIRECTORY = "http://serifos.eecs.harvard.edu:9030/tor/";
-my $LINK_STATUS = "http://serifos.eecs.harvard.edu:9030/tor/running-routers";
-my $F_CCODES = "/afs/eecs.harvard.edu/user/goodell/public_html/country-codes.txt";
-my $WGET = "/usr/bin/wget -O -";
-my $WHOIS = "/usr/bin/whois";
-my $DESC_SCRIPT = "/cgi-bin/desc.pl";
-my $WHOIS_SCRIPT = "/cgi-bin/whois.pl";
-my $ICON_HN = "hn.gif";
-my $ICON_UR = "ur.gif";
-my $ICON_S0 = "s0.gif";
-my $ICON_S1 = "s1.gif";
-my $ICON_V0 = "v0.gif";
-my $ICON_V1 = "v1.gif";
-my $ICON_V2 = "v2.gif";
-my $ICON_V3 = "v3.gif";
-my $P_FLAGS = "width=18 height=12";
-my $P_ICONS = "width=12 height=12";
-my $UV_TEXT = "officially named";
-my $SYS = "Tor";
-my $DEFAULT_PORT = "9030";
-my $HTTP_PROXY = "";
-my $DESC_DIR = "";
-my $BLOSSOM = 0;
-my $CACHEDAYS = 90;
-my $CACHESECONDS = 300;
-my $MAX_PORT = 65535;
-my $DNS_EXPIRATION = 86400;
-my $MAXNETLENGTH = 26;
-my $MAXNICKLENGTH = 20;
-my $MAXHOSTLENGTH = 58;
-my $V1_MINBW = 20;
-my $V2_MINBW = 60;
-my $V3_MINBW = 400;
-
-do $CONFIG if -r $CONFIG;
-
-# other global variables
-
-my %bw = ();
-my %ccode = ();
-my %directory = ();
-my %hops = ();
-my %hr = ();
-my %hw = ();
-my %oses = ();
-my %summary = ();
-my %tr = ();
-my %tw = ();
-my %uptime = ();
-
-my %cc_matches = ();
-my %dns_time = ();
-my %dns_name = ();
-
-my $DISPLAY_ADDR = undef;
-my $TEXTONLY = undef;
-my $SORTBW = undef;
-
-# variables for parsing the URI
-
-my %fields = ();
-
-my $uri = "";
-my $dnscachefile = "dnscache";
-my $invalid = undef;
-my $response = "";
-my $uri_text = "";
-my $uri_addr = "";
-my $uri_sort = "";
-my $uri_blossom = "";
-my $link_addr = "";
-my $link_sort = "";
-my $success = undef;
-
-# variables for parsing descriptors
-
-my %all_r = ();
-my %all_u = ();
-my %blossom_path = ();
-my %lines = ();
-my %num = ();
-
-my @addrbytes = ();
-my @lines = ();
-my @policy = ();
-my @running_routers = ();
-
-my $addr = "";
-my $cc = "";
-my $class = "";
-my $bandwidth = "";
-my $dpublished = "";
-my $dsignature = "";
-my $fingerprint = "";
-my $host = "";
-my $iaddr = "";
-my $icon = "";
-my $netname = "";
-my $p_router = "";
-my $router = "";
-my $router_td = "";
-my $platformline = "";
-my $service = "";
-my $spublished = "";
-my $system = "";
-my $version = "";
-
-my $hibernating = undef;
-my $named = undef;
-
-my $fpublished = 1;
-my $maxlength = 0;
-my $maxname = 0;
-my $orport = 0;
-my $socksport = 0;
-my $dirport = 0;
-my $minfast = 4294967295;
-
-$num{"uhi"} = 0;
-$num{"uur"} = 0;
-$num{"uv0"} = 0;
-$num{"uv1"} = 0;
-$num{"uv2"} = 0;
-$num{"uv3"} = 0;
-$num{"u"} = 0;
-$num{"vhi"} = 0;
-$num{"vur"} = 0;
-$num{"vv0"} = 0;
-$num{"vv1"} = 0;
-$num{"vv2"} = 0;
-$num{"vv3"} = 0;
-$num{"v"} = 0;
-
-use vars qw($license);
-
-# subroutines
-
-sub license() {
- print $license;
- exit 0;
-}
-
-sub addrouters($) {
- my @sorted = undef;
- my $href = shift;
- my $response = "";
- my %routers = %$href;
-
- if($SORTBW) {
- @sorted = sort { $uptime{$a} <=> $uptime{$b} } keys %routers;
- @sorted = sort { $hr{$a} + $hw{$a} <=> $hr{$a} + $hw{$b} } @sorted;
- @sorted = reverse sort { $tr{$a} + $tw{$a} <=> $tr{$b} + $tw{$b} } @sorted;
- } else {
- @sorted = sort keys %routers;
- }
-
- foreach my $router (@sorted) {
- if($TEXTONLY) {
- $response .= $routers{$router};
- } else {
- $response .= "<tr>\n " . $routers{$router} . "</tr>\n";
- }
- }
- return $response;
-}
-
-sub parsewhois($$$) {
- my ($tag, $default, $arrayref) = (shift, shift, shift);
- my $t;
- my @lines = @$arrayref;
- my @matches = grep /^$tag/i, @lines;
-
- if($matches[$#matches]) {
- chomp $matches[$#matches];
- ($t = $matches[$#matches]) =~ s/\S+\s+//g;
- } else {
- $t = $default;
- }
- return $t;
-}
-
-sub add_field($$) {
- my ($uri, $field) = (shift, shift);
-
- print STDERR "$uri\n";
-
- if($uri !~ /^$/) {
- $uri .= "&";
- }
- return $uri . $field;
-}
-
-sub remove_field($$) {
- my ($uri, $field) = (shift, shift);
- my @prompts = split /&/, $uri;
- my @returns = ();
-
- foreach my $prompt (@prompts) {
- push @returns, $prompt unless $prompt =~ /^$field=/;
- }
- return join "&", @returns;
-}
-
-sub padded_cell($;$) {
- my ($length, $class) = (shift, shift);
- my $tdclass = $class ? "<td class=\"$class\">" : "<td>";
- my $output = "$tdclass<tt>";
-
- for(my $x = 0; $x < $length; $x++) {
- $output .= " ";
- }
- $output .= "</tt></td>";
- return $output;
-}
-
-sub sum($) {
- my @terms = split /,/, shift;
- my $total = 0;
- foreach my $term (@terms) {
- $term += 2<<32 if $term > 0;
- $total += $term;
- }
- return $total;
-}
-
-sub by_totals {
- my $aa = $oses{$a}[0] + $oses{$a}[1];
- my $bb = $oses{$b}[0] + $oses{$b}[1];
-
- if($aa == $bb) {
- return $oses{$a}[0] <=> $oses{$b}[0];
- } else {
- return $aa <=> $bb;
- }
-}
-
-sub reset_globals {
- $class = $TD_DEFAULT;
- $p_router = undef;
- $router = undef;
- $router_td = undef;
- $icon = "<img $P_FLAGS src=\"$URL_ICONS/$ICON_V0\" alt=\"v0\">";
- $orport = 0;
- $socksport = 0;
- $dirport = 0;
- $hibernating = undef;
- $named = undef;
-
- @lines = ();
- @policy = ();
-}
-
-sub make_flag($) {
- my $cc = shift;
- my $ccy = lc $cc;
- my $f_ccode = $ccode{$cc} || "~~";
- my $flag = "<img $P_FLAGS src=\"$URL_FLAGS/$ccy.gif\" alt=\"$cc\">";
- return "<acronym title=\"$f_ccode\">$flag</acronym>";
-}
-
-# parse the URI parameters
-
-if($ENV{"REQUEST_URI"} && $ENV{"REQUEST_URI"} =~ /\?/) {
- ($uri = $ENV{"REQUEST_URI"}) =~ s/.*\?//g;
-}
-
-my @prompts = split /&/, $uri;
-
-open DNSCACHE, "<$CACHE/$dnscachefile";
-while(<DNSCACHE>) {
- if(/^(\S+)\s+(\S+)\s+(\S+)$/) {
- $dns_time{$2} = $1;
- $dns_name{$2} = $3;
- }
-}
-close DNSCACHE;
-
-foreach (@prompts) {
- my ($k, $v) = split /=/, $_;
- $fields{$k} = $v;
-}
-
-if($fields{"sortbw"}) {
- $SORTBW = 1;
- $uri_sort = remove_field($uri, "sortbw");
- $link_sort = "by country";
-} else {
- $uri_sort = add_field($uri, "sortbw=1");
- $link_sort = "by bandwidth";
-}
-
-if($fields{"ports"}) {
- if($fields{"ports"} !~ /^([0-9]+,)*[0-9]+$/) {
- $invalid = 1;
- } else {
- @portslist = split /,/, $fields{"ports"};
- foreach my $port (@portslist) {
- $invalid = 1 if $port > $MAX_PORT;
- }
- }
-}
-
-if($fields{"textonly"}) {
- $TEXTONLY = $fields{"textonly"};
-} else {
- $uri_text = add_field($uri, "textonly=1");
-}
-
-if($fields{"addr"}) {
- $DISPLAY_ADDR = 1;
- $uri_addr = remove_field($uri, "addr");
- $link_addr = "show hostnames";
-} else {
- $uri_addr = add_field($uri, "addr=1");
- $link_addr = "show addresses";
-}
-
-if($fields{"blossom"}) {
- my $B_PORT = $DEFAULT_PORT;
- $uri_blossom = remove_field($uri, "blossom");
- $BLOSSOM = $fields{"blossom"};
-
- if($fields{"textonly"}
- and $fields{"textonly"} eq "fingerprint"
- and $fields{"addr"}
- and not $fields{"sortbw"}) {
- }
-
- if($BLOSSOM =~ /^([A-Za-z0-9]+):([0-9]+)$/) {
- $BLOSSOM = $1;
- $B_PORT = $2;
- }
-
- $TITLE = "Blossom Network Status: $BLOSSOM";
- $URL_DIRECTORY = "http://$BLOSSOM.exit:$B_PORT/tor/";
- $URL_STATUS = "http://$BLOSSOM.exit:$B_PORT/tor/running-routers";
- $LINK_DIRECTORY = "http://$BLOSSOM.exit:$B_PORT/tor/";
- $LINK_STATUS = "http://$BLOSSOM.exit:$B_PORT/tor/running-routers";
- $HTTP_PROXY = "http_proxy=http://localhost:8119 ";
- $DESC_DIR = "$BLOSSOM:$B_PORT";
- $V1_MINBW = 0;
- $V2_MINBW = 4;
- $V3_MINBW = 60;
- $UV_TEXT = "directory server";
- $URL_HOME = "http://afs.eecs.harvard.edu/~goodell/blossom/";
- $SYS = "Blossom";
-}
-
-if($invalid) {
- print "Content-type: text/plain\n\n";
- print "invalid input: " . $fields{"ports"} . "\n";
- exit -1;
-}
-
-# parse file containing country codes
-
-open F, "<$F_CCODES" || warn "country code mapping not available";
-while(<F>) {
- if(!/^#/) {
- $ccode{$1} = $2 if /^(\S+)\s+(.+)$/;
- }
-}
-close F;
-
-# compose the header and navigation links
-
-$uri_text =~ s/&/&/g;
-$uri_addr =~ s/&/&/g;
-$uri_sort =~ s/&/&/g;
-
-if(defined $TEXTONLY) {
- $response = <<EOF
-Content-type: text/plain
-
-$TITLE
-
-EOF
-;
-} else {
- $response = <<EOF
-Content-type: text/html
-
-<!doctype html public "-//W3C//DTD HTML 4.01//EN"
- "http://www.w3.org/TR/html4/strict.dtd">
-<html>
-<head>
-<title>$TITLE</title>
-<meta name="Author" content="Geoffrey Goodell">
-<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
-<meta http-equiv="Content-Style-Type" content="text/css">
-<link rel="stylesheet" type="text/css" href="http://serifos.eecs.harvard.edu/style.css">
-</head>
-
-<body>
-
-<h1>$TITLE</h1>
-
-<p><tt>
- [<a href="#legend">explanation of symbols</a>]
- [<a href="?$uri_text">text only version</a>]
- [<a href="?$uri_addr">$link_addr</a>]
- [<a href="?$uri_sort">$link_sort</a>]
-</tt></p>
-
-<table>
-
-EOF
-;
-}
-
-# parse the descriptor
-
-open W, "$HTTP_PROXY$WGET $URL_STATUS |" || die;
-
-while(<W>) {
- if(/^published (.*)$/) {
- $spublished = "<a href=\"$LINK_STATUS\">network status</a> $1";
- } elsif(/^router-status /) {
- @running_routers = split;
- shift @running_routers;
- for(my $x = 0; $x <= $#running_routers; $x++) {
- $running_routers[$x] =~ s/=.*$//g;
- $running_routers[$x] =~ y/A-Z/a-z/;
- }
- }
-}
-
-close W;
-
-# parse version 2 directory data
-
-open W, "$HTTP_PROXY$WGET $URL_V2DIR |" || die;
-
-my $trtr = "";
-my %types = ();
-
-while(<W>) {
- if(/^r (\S+) /) {
- $trtr = lc $1;
- %{$types{$trtr}} = () unless $types{$trtr};
- } elsif(/^s (.*)$/) {
- my @characteristics = split / /, $1;
- foreach my $characteristic (@characteristics) {
- ${$types{$trtr}}{$characteristic} = 1;
- }
- }
-}
-
-# parse the descriptors
-
-open W, "$HTTP_PROXY$WGET $URL_DIRECTORY |" || die;
-
-while(<W>) {
- chomp;
- $success = 1;
-
- if(/^published (.*)$/ and $fpublished) {
- $dpublished = "<a href=\"$LINK_DIRECTORY\">directory published</a> $1";
- $fpublished = undef;
- } elsif(/^directory-signature (\S+)$/) {
- $dsignature = lc $1;
- } elsif(/^directory (\S+)\s+(\S+)\s*(\s+\S+)?$/) {
- $directory{$1} = $2;
- } elsif(/^summary (\S+)\s+(\S+)$/) {
- $summary{$1} = $2;
- } elsif(/^blossom-path (\S+)\s+(.+)$/) {
- $blossom_path{$1} = $2;
- } elsif(/^router (\S+) (\S+) (\S+) (\S+) (\S+)$/) {
- ($router, $addr, $orport, $socksport, $dirport) = ($1, $2, $3, $4, $5);
- $router = lc $router;
- $p_router = $router;
-
- $iaddr = inet_aton($addr);
- @addrbytes = split /\./, $addr;
- for(my $i = 0; $i < 4; $i++) {
- $addrbytes[$i] = int($addrbytes[$i]);
- }
-
- if(defined $DISPLAY_ADDR) {
- $host = sprintf "%-15s", $2;
- $host =~ s/ / /g if not defined $TEXTONLY;
- } else {
- my ($a, $b, $c, $d) = unpack 'C4', $iaddr;
- my $bytes = "$a.$b.$c.$d";
- if($dns_name{$bytes} and $dns_time{$bytes} and $dns_time{$bytes} > time - $DNS_EXPIRATION) {
- $host = $dns_name{$bytes};
- } else {
- print STDERR "DNS lookup: $bytes...";
- ($host = gethostbyaddr($iaddr, AF_INET) || $2) =~ y/A-Z/a-z/;
- my ($name, $aliases, $addpe, $length, @addrs) = gethostbyname($host);
- print STDERR "done.\n";
-
- if(not $addrs[0] or $addrs[0] ne $iaddr) {
- $host = $bytes;
- }
- $dns_time{$bytes} = time;
- $dns_name{$bytes} = $host;
- }
- }
- $service = 1;
- } elsif(/^platform Tor (\S+) on (\S+)(\s(\S+))?/) {
- $version = substr $1, 0, 20;
- $system = $2;
- my $extra = "";
- if($4) {
- $extra = $4;
- }
- ($platformline = $_) =~ s/^platform //;
- $platformline =~ s/\"//g;
-
- $system = "Other" unless grep /^$system$/, @os_names;
- if($system eq "Windows") {
- if($extra eq "Server" or $extra eq "XP") {
- $system .= $extra;
- } else {
- $system .= "Other";
- }
- }
- $system =~ s/\"//g;
- unless(defined $oses{$system}) {
- my @zeroes = (0, 0);
- $oses{$system} = \@zeroes;
- }
- } elsif(/^(opt\s+)?uptime\s+([0-9]+)$/) {
- $uptime{$router} = $2;
- } elsif(/^(opt\s+)?hibernating\s+([0-9]+)$/) {
- $hibernating = $2;
- } elsif(/^(opt\s+)?fingerprint\s+(.+)$/) {
- ($fingerprint = $2) =~ s/ //g;
- $fingerprint =~ y/a-z/A-Z/;
- } elsif(/^bandwidth ([0-9]+) ([0-9]+) ([0-9]+)$/) {
- if($1 > $3) {
- $bandwidth = $3;
- } else {
- $bandwidth = $1;
- }
- } elsif(/^(opt\s+)?read-history\s+\S+\s+\S+\s+\(([0-9]+)\s+s\)\s+(\S+)$/) {
- my @terms = split /,/, $3;
- $tr{$router} = sum($3);
- $hr{$router} = $tr{$router} / ($#terms+1) / $2;
- } elsif(/^(opt\s+)?write-history\s+\S+\s+\S+\s+\(([0-9]+)\s+s\)\s+(\S+)$/) {
- my @terms = split /,/, $3;
- $tw{$router} = sum($3);
- $hw{$router} = $tw{$router} / ($#terms+1) / $2;
- } elsif(/^accept \S+$/) {
- push @policy, $_;
- } elsif(/^reject \S+$/) {
- push @policy, $_;
- } elsif(/^$/) { # ----- BEGIN ROUTER PROCESSING SECTION -----
- my $cache_succ = undef;
- my $command = undef;
- my $t = undef;
-
- my $atag = $A_STANDARD;
- my $b = $directory{$router};
- my $length = 0;
- my $whois_proxy = 0;
- my $slen = 0;
- my $wrapper = "";
-
- my @netlast = ();
- my @matches = ();
-
- unless($router){
- reset_globals();
- next;
- }
-
- # support old scheme for determining hibernating pre-0.1 routers
-
- if(($version =~ /^0\.0\./)
- && ($uptime{$router} ne "0")
- && ($dirport eq "0")
- && ($bandwidth eq "0")) {
- $hibernating = 1;
- }
-
- # obtain WHOIS data: check the cache first
-
- if(-e "$CACHE/$addr") {
- my ($size, $modified) = (stat "$CACHE/$addr")[7, 9];
- $command = "<$CACHE/$addr" if $size && $size > 600 && $modified > time-86400*$CACHEDAYS;
- }
-
- # otherwise obtain WHOIS data from the Internet
-
- if(not defined $command) {
- $command = "$WHOIS $addr |";
- $t = 1;
- }
- open X, $command || warn;
-
- $cache_succ = open Y, ">$CACHE/$addr" if $t;
- while(<X>) {
-
- # conditions for using an external proxy to conduct WHOIS lookups
-
- # if($t and /^% This is the RIPE Whois query server #2\.$/) {
- # $t = 0;
- # $whois_proxy = 1;
- # last;
- # }
-
- push @lines, $_;
- push @netlast, $1 if /\((NET-\S+)\)/;
- print Y if $t && $cache_succ;
- }
- close X;
-
- # temporary workaround for permanent filtering
-
- if($whois_proxy) {
- @lines = ();
- open X, "$WGET $URL_WHOIS$addr |" or warn;
- while(<X>) {
- push @lines, $_;
- print Y if $cache_succ;
- }
- close X;
- }
-
- while(($#netlast > 0) and $t) {
- my $f = 1;
- my $netguess = pop @netlast;
- next unless $netguess and $netguess =~ /^[A-Za-z0-9-.]+$/;
- open X, "$WHOIS $netguess |" || warn;
-
- while(<X>) {
- push @lines, $_;
- print Y if $cache_succ;
- $f = 0 if /\((NET-\S+)\)/;
- }
- close X;
- last if $f;
- }
- close Y if $cache_succ;
-
- # parse router statistics
-
- @matches = grep /^!?$router$/, @running_routers;
- if(not defined $matches[0]) {
- # if($BLOSSOM == 0) {
- # $class = "td class=\"$A_UNVERIFIED\"";
- # $atag = $A_UNVERIFIED;
- # $p_router = "*$router";
- # $service = undef;
- # }
- @matches = grep /^!?\$$fingerprint/, @running_routers;
- }
-
- if($types{$router} and ${$types{$router}}{"Named"}) {
- $class = "td class=\"$A_UNVERIFIED\"";
- $atag = $A_UNVERIFIED;
- $p_router = "*$router";
- $named = 1;
- }
-
- if($b) {
- $class = "td class=\"$A_UNVERIFIED\"";
- $atag = $A_UNVERIFIED;
- $p_router = "*$router";
- }
-
- if($types{$router} and ${$types{$router}}{"Authority"}) {
- $class = "td class=\"$A_AUTHORITY\"";
- $atag = $A_STANDARD;
- $p_router = "*$router";
- $named = 1;
- }
-
- if($matches[0] && $matches[0] =~ /^!/) {
- $bandwidth = 0;
- if($hibernating) {
- $icon = "<acronym title=\"hibernating\"><img $P_FLAGS src=\"$URL_ICONS/$ICON_HN\" alt=\"hn\"></acronym>";
- $num{"uhi"}++ if $named or $b;
- $num{"vhi"}++;
- $bw{$router} = -1;
- } else {
- $icon = "<acronym title=\"unresponsive\"><img $P_FLAGS src=\"$URL_ICONS/$ICON_UR\" alt=\"ur\"></acronym>";
- $num{"uur"}++ if $named or $b;
- $num{"vur"}++;
- $bw{$router} = -2;
- }
- $oses{$system}[1]++ if $named or $b;
- $oses{$system}[0]++;
- $service = undef;
- } else {
- my $tooslow = undef;
- $bw{$router} = $bandwidth;
- if(not $types{$router} or not ${$types{$router}}{"Fast"}) {
- $num{"uv0"}++ if $named or $b;
- $num{"vv0"}++;
- $tooslow = 1;
- } elsif($bandwidth >= $V3_MINBW*1000) {
- $icon = "<img $P_FLAGS src=\"$URL_ICONS/$ICON_V3\" alt=\"v3\">";
- $num{"uv3"}++ if $named or $b;
- $num{"vv3"}++;
- } elsif($bandwidth >= $V2_MINBW*1000) {
- $icon = "<img $P_FLAGS src=\"$URL_ICONS/$ICON_V2\" alt=\"v2\">";
- $num{"uv2"}++ if $named or $b;
- $num{"vv2"}++;
- } else {
- $icon = "<img $P_FLAGS src=\"$URL_ICONS/$ICON_V1\" alt=\"v1\">";
- $num{"uv1"}++ if $named or $b;
- $num{"vv1"}++;
- $minfast = $bandwidth if $bandwidth < $minfast;
- }
- $icon = "<acronym title=\"$bandwidth B/s\">$icon</acronym>";
- $oses{$system}[1]++ if $named or $b;
- $oses{$system}[0]++;
- $service = undef if $tooslow and ($BLOSSOM == 0);
- }
-
- # determine the network name from WHOIS results
-
- $netname = parsewhois("netname", "", \@lines);
- $netname = $addr if length($netname) > $MAXHOSTLENGTH - 16;
-
- # determine the country (and correct network name if necessary)
-
- $t = parsewhois("country", undef, \@lines);
-
- # RFC 1918
-
- if($addrbytes[0] == 10
- or ($addrbytes[0] == 172
- and $addrbytes[1] > 15
- and $addrbytes[1] < 32)
- or ($addrbytes[0] == 192
- and $addrbytes[1] == 168)) {
- $t = "19";
- }
-
- # RFC 3330
-
- if($addrbytes[0] == 0
- or $addrbytes[0] == 127
- or ($addrbytes[0] == 169
- and $addrbytes[1] == 254)) {
- $t = "33";
- }
-
- unless($t) {
- $t = "~~";
-
- # Exception: Brazil
- if(parsewhois("% Copyright registro.br", undef, \@lines)) {
- $t = "BR";
- $netname = parsewhois("aut", "", \@lines);
- }
-
- # Exception: Japan
- if(parsewhois("\\\[ JPNIC database", undef, \@lines)) {
- $t = "JP";
- $netname = parsewhois("b. \\\[Network Name\\\]", "", \@lines);
- }
-
- # Exception: Korea
- if(parsewhois("# KOREAN", undef, \@lines)) {
- $t = "KR";
- $netname = parsewhois("Service Name", "", \@lines);
- }
- }
- ($cc = $t) =~ y/a-z/A-Z/;
-
- $netname = $addr if $netname eq "";
-
- # generate the wrapper for the host information column
-
- $t = "";
- if($SORTBW) {
- my $days = int ($uptime{$router}/86400);
- $days = "err" if $days > 999;
-
- $slen = 1;
- # $t = sprintf "%7s B/s %3sd ", $bandwidth, $days;
- $t = sprintf "%4s %4s %4s ",
- int($bw{$router}/1000), int($hr{$router}/1000), int($hw{$router}/1000);
- $t = " err err err " if length $t > 15;
- my $tt = sprintf "%4s ", int($uptime{$router}/86400);
- if(length $tt > 5) {
- $t .= " err ";
- } else {
- $t .= $tt;
- }
- $wrapper = $t;
- $wrapper =~ s/ / /g if not $TEXTONLY;
- $host = $wrapper . $host;
- if($DISPLAY_ADDR) {
- $host .= " $version";
- $host =~ s/ / /g if not $TEXTONLY;
- }
- } elsif(not $TEXTONLY) {
- $slen = 3;
- $t = $netname;
- $wrapper = " [<a class=\"$atag\" href=\"$WHOIS_SCRIPT?q=$addr\">$t</a>]";
- $host .= $wrapper;
- }
- $length = $slen + (length $host)-(length $wrapper)+(length $t);
-
- # format the host information to satisfy length constraints
-
- if(($length > $MAXHOSTLENGTH) && (not $DISPLAY_ADDR) && (not $TEXTONLY)) {
- if($SORTBW) {
- (my $name = $host) =~ s/^.*;//g;
- $host = substr $name, $length-$MAXHOSTLENGTH;
- $host =~ s/^(\S+?)\./\*\./;
- ($host = $t . $host) =~ s/ / /g;
- } else {
- $host = substr $host, $length-$MAXHOSTLENGTH;
- $host =~ s/^(\S+?)\./\*\./;
- }
- }
- if($DISPLAY_ADDR) {
- if($SORTBW) {
- $length = $slen + 36 + (length $version);
- } else {
- $length = $slen + 16 + (length $t);
- }
- } else {
- $length = $slen + (length $host)-(length $wrapper)+(length $t);
- }
-
- $maxlength = $length if $maxlength < $length;
-
- $p_router = substr $p_router, 0, $MAXNICKLENGTH if length $router > $MAXNICKLENGTH;
- if($BLOSSOM) {
- if($b) {
- my $b_port = ($b == $DEFAULT_PORT) ? "" : ":$b";
- my $uri_redirect = add_field($uri_blossom, "blossom=$router$b_port");
- $router_td = "<a class=\"$atag\" href=\"?$uri_redirect\">$p_router</a>";
- } else {
- $router_td = "<a class=\"$atag\" href=\"$DESC_SCRIPT?q=$router&blossom=$DESC_DIR\">$p_router</a>";
- }
- } else {
- $router_td = "<a class=\"$atag\" href=\"$DESC_SCRIPT?q=$router\">$p_router</a>";
- }
- $maxname = length $p_router if $maxname < length $p_router;
-
- if($SORTBW) {
- $router_td = sprintf "%s %s", make_flag($cc), $router_td;
- } else {
- if($cc =~ /US|CA/) {
- $t = parsewhois("stateprov", " ", \@lines);
- $t = "~~" unless $t =~ /^[A-Z][A-Z]$/;
- $router_td = "$t $router_td ";
- } else {
- $router_td = " $router_td ";
- }
- }
- $cc_matches{$cc} = 0 if not defined $cc_matches{$cc};
-
- # ----- END ROUTER PROCESSING SECTION -----
-
- my %accept = ();
-
- # format the output for this router
-
- if($TEXTONLY) {
- my $format = "%2s %-${MAXNICKLENGTH}s ";
-
- $p_router = substr $p_router, 0, $MAXNICKLENGTH;
- if($DISPLAY_ADDR and not $SORTBW) {
- my $tformat = "%7s B/s %-15s %-${MAXNETLENGTH}s";
- $netname = substr $netname, 0, $MAXNETLENGTH;
- $host = sprintf $tformat, $bandwidth, $host, $netname;
- $format .= "%s";
- } else {
- $host = substr $host, 0, $MAXHOSTLENGTH;
- $format .= "%-${MAXHOSTLENGTH}s";
- }
- ${$lines{$cc}}{$router} = sprintf $format, $cc, $p_router, $host;
- } else {
- ${$lines{$cc}}{$router} = "<$class><tt>$router_td</tt></td><$class><tt>$icon $host</tt></td>\n";
- }
-
- # parse exit policy
-
- foreach my $PORT (@portslist) {
- for(my $x = 0; $x <= $#policy; $x++) {
- if($policy[$x] =~ /^(\S+) \*:([0-9]+)-([0-9]+)$/) {
- if ($2 <= $PORT && $3 >= $PORT) {
- $accept{$PORT} = 1 if $1 eq "accept";
- last;
- }
- } elsif($policy[$x] =~ /^(\S+) \*:$PORT$/) {
- $accept{$PORT} = 1 if $1 eq "accept";
- last;
- } elsif($policy[$x] =~ /^(\S+) \*:\*$/) {
- $accept{$PORT} = 1 if $1 eq "accept";
- last;
- }
- }
- }
-
- unless($TEXTONLY) {
- ${$lines{$cc}}{$router} .= " <td class=\"centered\"><acronym title=\"$platformline\"><img $P_ICONS src=\"$URL_OSICONS/$system.png\" alt=\"*\"></acronym></td>\n";
- }
-
- # compose exit policy output
-
- my $f = undef;
-
- if($TEXTONLY and $TEXTONLY eq "fingerprint") {
- ${$lines{$cc}}{$router} .= " $fingerprint";
- } else {
- foreach my $PORT (@portslist) {
- if($TEXTONLY) {
- if(defined $accept{$PORT}) {
- ${$lines{$cc}}{$router} .= sprintf "%5s", $PORT;
- $f = 1;
- } else {
- ${$lines{$cc}}{$router} .= " -";
- }
- } else {
- if(defined $accept{$PORT}) {
- if($service) {
- ${$lines{$cc}}{$router} .= " <td class=\"entry\"><tt>$PORT</tt></td>\n";
- } else {
- ${$lines{$cc}}{$router} .= " <td class=\"dimentry\"><tt>$PORT</tt></td>\n";
- }
- } else {
- ${$lines{$cc}}{$router} .= sprintf " %s\n", padded_cell(4);
- }
- }
- }
- }
- ${$lines{$cc}}{$router} .= "\n" if defined $TEXTONLY;
- delete ${$lines{"~~"}}{$router} if ${$lines{"~~"}}{$router};
- delete $lines{"~~"} unless (keys %{$lines{"~~"}});
- $hops{$router} = -1;
- $cc_matches{$cc}++ if $f;
-
- # display Blossom summaries
-
- if($summary{$router}) {
- foreach my $elt (split /,/, $summary{$router}) {
- my $num_hops = "1";
- my $router_elt = $router;
- if($elt =~ /^(\S+)=([0-9]+)$/) {
- $router_elt = $1;
- $num_hops = $2;
- }
-
- next if $router_elt eq $router;
-
- @matches = grep /^!?$router_elt$/, @running_routers;
- if(defined $matches[0]) {
- $icon = "<img $P_FLAGS src=\"$URL_ICONS/$ICON_S1\" alt=\"s1\">";
- } else {
- $icon = "<img $P_FLAGS src=\"$URL_ICONS/$ICON_S0\" alt=\"s0\">";
- }
- if((not $hops{$router_elt}) or $hops{$router_elt} > int $num_hops) {
-
- $hops{$router_elt} = int $num_hops;
- %{$lines{"~~"}} = () unless $lines{"~~"};
-
- if($TEXTONLY) {
- ${$lines{"~~"}}{$router_elt} = " $router_elt\n";
- } else {
- ${$lines{"~~"}}{$router_elt} = " <td><tt> $router_elt </tt></td>\n";
- ${$lines{"~~"}}{$router_elt} .= " <td><tt>$icon $num_hops via $router</tt></td>\n";
- }
-
- }
- }
- }
-
- # reset the control variables for the next router
-
- reset_globals();
- }
-}
-close W;
-
-# compose the table of results
-
-my $f;
-foreach $cc (sort keys %lines) {
- if($cc !~ /^$/) {
- my $flag = make_flag($cc);
- my $nodes = scalar keys %{$lines{$cc}};
-
- my $upnodes = 0;
- foreach $router (sort keys %{$lines{$cc}}) {
- if(${$lines{$cc}}{$router} !~ /hibernating/
- and ${$lines{$cc}}{$router} !~ /unresponsive/) {
- $upnodes++
- }
- }
-
- if($SORTBW) {
- foreach $router (sort keys %{$lines{$cc}}) {
- if(${$lines{$cc}}{$router} =~ /unresponsive/) {
- $all_u{$router} = ${$lines{$cc}}{$router};
- } else {
- $all_r{$router} = ${$lines{$cc}}{$router};
- }
- }
- } else {
-
- if(defined $f) {
- if(not defined $TEXTONLY) {
- $response .= sprintf "\n<tr>%s</tr>\n", padded_cell(1);
- }
- } else {
- $f = 1;
- }
-
- if(defined $TEXTONLY) {
- $response .= "\n$cc [$nodes] " . $cc_matches{$cc} . "\n";
- } else {
- $response .= "<tr>\n";
- $response .= " <td class=\"heading\"><tt>$cc $flag $upnodes/$nodes</tt></td>\n";
- $response .= sprintf " %s\n", padded_cell($maxlength + 4, "heading");
- $response .= sprintf " %s\n", padded_cell(2);
- foreach my $PORT (@portslist) {
- $response .= sprintf " %s\n", padded_cell(4);
- }
- $response .= "</tr>\n";
- }
- $response .= addrouters(\%{$lines{$cc}});
- }
- }
-}
-
-if($SORTBW) {
- $response .= addrouters(\%all_r);
-
- # add a blank line between responsive and unresponsive routers
-
- unless($TEXTONLY) {
- $response .= "<tr>\n";
- $response .= sprintf " %s\n", padded_cell($maxname+5);
- $response .= sprintf " %s\n", padded_cell($maxlength+4);
- $response .= sprintf " %s\n", padded_cell(2);
- foreach my $PORT (@portslist) {
- $response .= sprintf " %s\n", padded_cell(4);
- }
- $response .= "</tr>\n";
- }
-
- $response .= addrouters(\%all_u);
-}
-
-
-# perform final formatting operations
-
-$num{"v"} = $num{"vur"}+$num{"vhi"}+$num{"vv0"}+$num{"vv1"}+$num{"vv2"}+$num{"vv3"};
-$num{"u"} = $num{"uur"}+$num{"uhi"}+$num{"uv0"}+$num{"uv1"}+$num{"uv2"}+$num{"uv3"};
-
-foreach my $number (sort keys %num) {
- $num{$number} = sprintf "%4s", $num{$number};
- $num{$number} =~ s/ / /g;
-}
-
-if($uri ne "") {
- $uri = "%3F$uri";
- $uri =~ s/&/%26/g;
- $uri =~ s/=/%3D/g;
-}
-
-# compose the legend and footer
-
-if(not defined $TEXTONLY) {
- my @bwheader = {"", "", "", ""};
- if($BLOSSOM) {
- $bwheader[0] = "zero throughput";
- $bwheader[1] = "marginal throughput";
- } else {
- $minfast = int($minfast/1000);
- $bwheader[0] = "zero or marginal throughput";
- $bwheader[1] = "throughput above eighth octile";
- }
- $bwheader[2] = "throughput >= $V2_MINBW kB/s";
- $bwheader[3] = "throughput >= $V3_MINBW kB/s";
- $response .= <<EOF
-
-</table>
-
-<p></p>
-
-<table id=legend>
- <tr>
- <td><tt><img $P_FLAGS src="$URL_ICONS/$ICON_UR" alt="ur"> = unresponsive node</tt></td>
- <td class="number"><tt>${num{vur}}</tt></td>
- <td class="unverifiednumber"><tt>${num{uur}}</tt></td>
- </tr><tr>
- <td><tt><img $P_FLAGS src="$URL_ICONS/$ICON_HN" alt="hn"> = hibernating node</tt></td>
- <td class="number"><tt>${num{vhi}}</tt></td>
- <td class="unverifiednumber"><tt>${num{uhi}}</tt></td>
- </tr><tr>
- <td><tt><img $P_FLAGS src="$URL_ICONS/$ICON_V0" alt="v0"> = $bwheader[0]</tt></td>
- <td class="number"><tt>${num{vv0}}</tt></td>
- <td class="unverifiednumber"><tt>${num{uv0}}</tt></td>
- </tr><tr>
- <td><tt><img $P_FLAGS src="$URL_ICONS/$ICON_V1" alt="v1"> = $bwheader[1]</tt></td>
- <td class="number"><tt>${num{vv1}}</tt></td>
- <td class="unverifiednumber"><tt>${num{uv1}}</tt></td>
- </tr><tr>
- <td><tt><img $P_FLAGS src="$URL_ICONS/$ICON_V2" alt="v2"> = $bwheader[2]</tt></td>
- <td class="number"><tt>${num{vv2}}</tt></td>
- <td class="unverifiednumber"><tt>${num{uv2}}</tt></td>
- </tr><tr>
- <td><tt><img $P_FLAGS src="$URL_ICONS/$ICON_V3" alt="v3"> = $bwheader[3]</tt></td>
- <td class="number"><tt>$num{vv3}</tt></td>
- <td class="unverifiednumber"><tt>$num{uv3}</tt></td>
- </tr>
- <tr><td><tt> </tt></td></tr>
-EOF
-;
-
- # provide OS statistics
-
- foreach my $os (reverse sort by_totals keys %oses) {
- my $vn = sprintf "%4s", $oses{$os}[0];
- my $un = sprintf "%4s", $oses{$os}[1];
- my $f_os = $os;
- $f_os =~ s/Windows/Windows /;
- $f_os =~ s/Linux64/Linux 64/;
-
- $vn =~ s/ / /g;
- $un =~ s/ / /g;
-
- $response .= <<EOF
- <tr>
- <td><tt>os <img $P_ICONS src="$URL_OSICONS/$os.png" alt="*"> $f_os</tt></td>
- <td class="number"><tt>$vn</tt></td>
- <td class="unverifiednumber"><tt>$un</tt></td>
- </tr>
-EOF
-;
- }
-
- $response .= <<EOF
- <tr>
- <td class="unverified"><tt>* = $UV_TEXT</tt></td>
- </tr><tr>
- <td><tt>total nodes</tt></td>
- <td class="number"><tt>${num{v}}</tt></td>
- <td class="unverifiednumber"><tt>${num{u}}</tt></td>
- </tr><tr>
- <td><tt>directory signature $dsignature</tt></td>
- </tr><tr>
- <td><tt>$dpublished</tt></td>
- <td><tt> UTC</tt></td>
- <td><tt> </tt></td>
- </tr><tr>
- <td><tt>$spublished</tt></td>
- <td><tt> UTC</tt></td>
- <td><tt> </tt></td>
- <tr><td><tt><a href="$URL_SOURCE">source code</a> [<a href="$URL_HOME">official $SYS website</a>]</tt></td></tr>
-</table>
-
-<p><a href="http://validator.w3.org/check?uri=http%3A%2F%2Fserifos.eecs.harvard.edu%2Fcgi-bin%2Fexit.pl$uri"><img src="http://validator.w3.org/images/vh401.gif" alt="valid HTML 4.01"/></a></p>
-
-<p><a href="http://jigsaw.w3.org/css-validator/validator?uri=http%3A%2F%2Fserifos.eecs.harvard.edu%2Fcgi-bin%2Fexit.pl"><img src="http://jigsaw.w3.org/css-validator/images/vcss" alt="valid CSS"/></a></p>
-
-</body></html>
-
-EOF
-;
-}
-
-# cache the result
-
-open DNSCACHE, ">$CACHE/$dnscachefile";
-foreach my $ent (sort keys %dns_time) {
- print DNSCACHE "$dns_time{$ent} $ent $dns_name{$ent}\n";
-}
-close DNSCACHE;
-
-# output the result
-
-print $response;
-exit 0;
-
More information about the tor-commits
mailing list