branches/0.4.3/SrSv/TOR.pm

   1 #!/usr/bin/perl
   2
   3 #       This file is part of SurrealServices.
   4 #
   5 #       SurrealServices is free software; you can redistribute it and/or modify
   6 #       it under the terms of the GNU General Public License as published by
   7 #       the Free Software Foundation; either version 2 of the License, or
   8 #       (at your option) any later version.
   9 #
  10 #       SurrealServices is distributed in the hope that it will be useful,
  11 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 #       GNU General Public License for more details.
  14 #
  15 #       You should have received a copy of the GNU General Public License
  16 #       along with SurrealServices; if not, write to the Free Software
  17 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18
  19 =pod
  20         Parses the TOR router list for exit-nodes, and optionally
  21         for exit-nodes that can connect to our services.
  22
  23         Interface still in progress.
  24 =cut
  25
  26 package SrSv::TOR;
  27 use strict;
  28
  29 use Exporter 'import';
  30 BEGIN { our @EXPORT = qw( getTorRouters ); }
  31
  32 sub openURI($) {
  33         my ($URI) = @_;
  34         my $fh;
  35         if($URI =~ s/^file:\/\///i) {
  36                 use IO::File;
  37                 $fh = IO::File->new($URI, 'r') or die;
  38         } else {
  39         # assume HTTP/FTP URI
  40                 use IO::Pipe;
  41                 $fh = IO::Pipe->new();
  42                 $fh->reader(qq(wget -q -O - $URI)) or die;
  43         }
  44         return $fh;
  45 }
  46
  47 our %TOR_cmdhash;
  48 BEGIN {
  49 %TOR_cmdhash = (
  50         'r'             => \&TOR_r,
  51         's'             => \&TOR_s,
  52         'router'        => \&TOR_router,
  53         'reject'        => \&TOR_reject,
  54         'accept'        => \&TOR_accept,
  55 );
  56 }
  57
  58 sub parseTorRouterList($) {
  59         my ($fh) = @_;
  60         our (%currentRouter, @routerList);
  61         foreach my $l (<$fh>) {
  62                 my ($tok, undef) = split(' ', $l, 2);
  63                 #print "$l";
  64                 chomp $l;
  65                 if(my $code = $TOR_cmdhash{$tok}) {
  66                         &$code($l);
  67                 }
  68         }
  69         sub TOR_r {
  70                 my ($l) = @_;
  71                 #r atari i2i65Qm8DXfRpHVk6N0tcT0fxvs djULF2FbASFyIzuSpH1Zit9cYFc 2007-10-07 00:19:17 85.31.187.200 9001 9030
  72                 my (undef, $name, undef, undef, undef, $ip, $in_port, $dir_port) = split(' ', $l);
  73                 %currentRouter = ( NAME => $name, IP => $ip, IN_PORT => $in_port, DIR_PORT => $dir_port );
  74                 return;
  75         }
  76         sub TOR_s {
  77                 my ($l) = @_;
  78                 if($l =~ /^s (.*)/) {
  79                 #s Exit Fast Guard Stable Running V2Dir Valid
  80                         my $tokens = $1;
  81                         # uncomment the conditional if you trust the router status flags
  82                         #if($tokens =~ /Exit/) {
  83                                 push @routerList, $currentRouter{IP};
  84                         #}
  85                 }
  86         }
  87         sub TOR_router {
  88                 my ($l) = @_;
  89                 my (undef, $name, $ip, $in_port, undef, $dir_port) = split(' ', $l);
  90                 push @routerList, processTorRouter(%currentRouter) if scalar(%currentRouter);
  91                 %currentRouter = ( NAME => $name, IP => $ip, IN_PORT => $in_port, DIR_PORT => $dir_port );
  92                 return;
  93         }
  94         sub TOR_reject {
  95                 my ($l) = @_;
  96                 my ($tok, $tuple) = split(' ', $l);
  97                 my ($ip, $ports) = split(':', $tuple);
  98                 push @{$currentRouter{REJECT}}, "$ip:$ports";
  99         }
 100         sub TOR_accept {
 101                 my ($l) = @_;
 102                 my ($tok, $tuple) = split(' ', $l);
 103                 my ($ip, $ports) = split(':', $tuple);
 104                 push @{$currentRouter{ACCEPT}}, "$ip:$ports";
 105         }
 106         #close $fh;
 107         return @routerList;
 108 }
 109
 110 sub processTorRouter(%) {
 111 # only used for v1, and possibly v3
 112         my (%routerData) = @_;
 113         my @rejectList = ( $routerData{REJECT} and scalar(@{$routerData{REJECT}}) ? @{$routerData{REJECT}} : () );
 114         my @acceptList = ( $routerData{ACCEPT} and scalar(@{$routerData{ACCEPT}}) ? @{$routerData{ACCEPT}} : () );
 115         return () if $routerData{IP} =~ /^(127|10|192\.168)\./;
 116         if ( (scalar(@rejectList) == 1) and ($rejectList[0] eq '*:*') ) {
 117                 #print STDERR "$routerData{IP} is not an exit node.\n";
 118                 return ();
 119         } else {
 120                 #print STDERR "$routerData{IP} is an exit node.\n";
 121                 return ($routerData{IP});
 122         }
 123 }
 124
 125 sub getTorRouters($) {
 126         my ($URI) = @_;
 127         return parseTorRouterList(openURI($URI));
 128 }
 129
 130 1;