SHARE
TWEET

redir_ssl.pl

a guest Mar 24th, 2012 34 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/bin/perl
  2. #
  3. #  Redir SSL for Squid v0.1
  4. #
  5. #  Copyright (C) 2008 asq@asq.art.pl
  6. #
  7. #  This program is free software; you can redistribute it and/or modify
  8. #  it under the terms of the GNU General Public License Version 2 as
  9. #  published by the Free Software Foundation.
  10. #
  11. #  This program is distributed in the hope that it will be useful,
  12. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. #  GNU General Public License for more details.
  15. #
  16. #  You should have received a copy of the GNU General Public License
  17. #  along with this program; if not, write to the Free Software
  18. #  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
  19. #  USA.
  20. #
  21. #  $Id$
  22.  
  23. use POSIX;
  24. use DBI;
  25. use DBD::SQLite;
  26. use LWP::UserAgent;
  27. use Net::Telnet ();
  28. use Sys::SigAction qw(timeout_call);
  29. use strict;
  30.  
  31. $|=1;
  32.  
  33. my $dbfile='/var/db/squid/ssl.db';
  34. my $timeout=5;
  35.  
  36. my $dbh;
  37.  
  38. if (!-f $dbfile) {
  39.     $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",{PrintError=>1}) || die $DBI::errstr;
  40.     &create_db || die;
  41. } else {
  42.     $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile","","",{PrintError=>1}) || die $DBI::errstr;
  43. }
  44.  
  45. while (<>) {
  46.     chomp;
  47.     @_ = split /\s+/;
  48.     my $url=$_[0];
  49.     my $ip=$_[1];
  50.     my $user=$_[2];
  51.     my $method=$_[3];
  52.     if ($method ne 'CONNECT') {
  53.         &return_ok($_,'not an SSL attempt at all');
  54.         next;
  55.     } else {
  56.         my $url_up_one=$url;
  57.         $url_up_one=~s/.*?\./\./;
  58.         # check if we're whitelisted
  59.         &check_in_wl($url) && &return_ok($url,'whitelisted') && next;
  60.         &check_in_wl($url_up_one) && &return_ok($url_up_one,'whitelisted') && next;
  61.  
  62.         # check if we already know anything about site
  63.         my ($code,$msg) = &check_url($url);
  64.         if ($code) {
  65.             &return_ok($url,$msg);
  66.             next;
  67.         } else {
  68.             &return_fail($url,$msg);
  69.             next;
  70.         }
  71.     }
  72. }
  73.  
  74. $dbh->disconnect();
  75.  
  76. sub create_db {
  77.     &log('No DB -- creating');
  78.     my $sth = $dbh->prepare("CREATE TABLE 'whitelisted' (id integer primary key autoincrement, url text, date int not null, user text not null, reason text not null)");
  79.     $sth->execute() || return 0;
  80.     $sth = $dbh->prepare("CREATE TABLE cache (id integer primary key autoincrement, url text, is_verified boolean, expiry int, cipher text, issuer text, subject text, comment text)");
  81.     $sth->execute() || return 0;
  82.     return 1;
  83. }
  84.  
  85. sub log {
  86.     my $msg=shift;
  87.     my $timenow=strftime("%Y/%m/%d %H:%M:%S", localtime);
  88.     print STDERR "$timenow| ".$0."[$$]: $msg\n";
  89. }
  90.  
  91. sub return_ok {
  92.     my $url=shift;
  93.     my $msg=shift||'no reason';
  94.     &log("=> $url <= PASSING: $msg");
  95.     print "\n";
  96. }
  97.  
  98. sub return_fail {
  99.     my $url=shift;
  100.     my $msg=shift||'ERROR: Unknown error please contact your administrator!';
  101.     my $blockurl='http://w3cache.non.3dart.com/SSLvfail.html';
  102.     &log("=> $url <= BLOCKING: $msg");
  103.     $msg=~s/\s+/\+/g;
  104.     print "302:$blockurl?url=$url&reason=$msg\n";
  105. }
  106.  
  107. sub check_in_wl {
  108.     my $url=shift;
  109.     my $sth = $dbh->prepare("SELECT url FROM whitelisted WHERE url=?") || die;
  110.     $sth->execute($url) || die;
  111.     my $row = $sth->fetch;
  112.     if ($row->[0]) {
  113.         return 1;
  114.     }
  115.     return 0;
  116. }
  117.  
  118. sub check_in_cache {
  119.     my $url=shift;
  120.     my $timenow=time();
  121.     my $sth;
  122.     # delete stale cache entries if any
  123.     if (time()%60 eq 0) {
  124.         &log('Sweeping cache');
  125.         $sth = $dbh->prepare("DELETE FROM cache WHERE expiry<=?");
  126.         $sth->execute($timenow) || die;
  127.     } else {
  128.         &log('Cleaning up cache for '.$url);
  129.         $sth = $dbh->prepare("DELETE FROM cache WHERE url=? and expiry<=?");
  130.         $sth->execute($url,$timenow) || die;
  131.     }
  132.     # check if we already know anything about site
  133.     $sth = $dbh->prepare("SELECT url,is_verified,comment FROM cache WHERE url=? and expiry>?") || die;
  134.     $sth->execute($url,$timenow) || die;
  135.     my $row = $sth->fetch;
  136.     if ($row->[0]) {
  137.         if ($row->[1]) {
  138.             # yes! it's clean
  139.             &log("$url is clean in cache");
  140.             return 1,$row->[2];
  141.         } else {
  142.             # yes! block it
  143.             &log("$url blocked in cache: ".$row->[2]);
  144.             return 0, $row->[2];
  145.         }
  146.     } else {
  147.         # inconclusive
  148.         &log("$url not in cache");
  149.         return -1;
  150.     }
  151. }
  152.  
  153. sub check_url {
  154.     my $url=shift;
  155.     my ($status,$msg,$r);
  156.     ($status,$msg) = &check_in_cache($url);
  157.     if ($status eq -1) {
  158.         foreach ('https://'.$url.'/robots.txt', 'https://'.$url.'/favicon.ico', 'https://'.$url.'/') {
  159.             ($status,$msg,$r)=&check_one_url($_);
  160.             last if ($status eq 1);
  161.         }
  162.         # this is expensive - run last, only if all previous test succeeded
  163.         if ($status eq 1) {
  164.             my ($status_p,$msg_p)=&check_proto($url);
  165.             if ($status_p eq 0) {
  166.                 &write_in_cache($status_p,$url,$msg_p);
  167.                 return $status_p, $msg_p;
  168.             }
  169.         }
  170.         &write_in_cache($status,$url,$msg,$r);
  171.         return $status, $msg;
  172.     } else {
  173.         return $status, $msg;
  174.     }
  175. }
  176.  
  177. sub check_proto {
  178.     my $url=shift;
  179.     my $host;
  180.     my $port;
  181.     if ($url=~/^(.*):(\d+)$/) {
  182.         $host=$1;
  183.         $port=$2;
  184.     } else {
  185.         $host=$url;
  186.         $port=80;
  187.     }
  188.     my $proto = new Net::Telnet (Telnetmode => 0, Timeout => $timeout, Errmode => 'return');
  189.     $proto->open(Host => $host, Port => $port) || return 0,"Unable to connect: ".$proto->errmsg();
  190.  
  191.     ## Read connection message.
  192.     my $line;
  193.     eval { $line = $proto->getline; };
  194.     if ($line) {
  195.         chomp($line);
  196.         # talked first, not https
  197.         &log("Protocol error: $line");
  198.         return 0, "Protocol error: $line";
  199.     } else {
  200.         &log("$url - protocol clean");
  201.         return 1,"$url - protocol clean";
  202.     }
  203. }
  204.  
  205. sub check_one_url {
  206.     my $url=shift;
  207.     my $ua = LWP::UserAgent->new(keep_alive => 0,timeout => $timeout);
  208.     $ua->proxy(https => undef);
  209.     $ENV{'https_proxy'}='';
  210.     $ua->agent('Mozilla/5.0 Probe');
  211.     my $rq=HTTP::Request->new(GET => $url);
  212.     my $r;
  213.  
  214.     # protect us from network timeouts
  215.     # $r=$ua->request($rq);
  216.     if (timeout_call ($timeout+1, sub { $r=$ua->request($rq); } )) {
  217.         $r=HTTP::Response->new(408,
  218.                                 "Connection timed out",
  219.                                 [ 'Client-Warning' => 'Internal response' ]
  220.                               ); #408 is the HTTP timeout
  221.     } else {
  222.         $r;
  223.     }
  224.  
  225.     my $status=$r->status_line;
  226.     if ($r->header('Client-Warning')) { # Internal response
  227.         &log("GET $url internal fatal: ".$r->header('Client-Warning')." ".$status);
  228.         return 0, 'INTERNAL: '.$status, $r;
  229.     }
  230.     if ($r->is_success) {
  231.         &log("GET $url ok: ".$status);
  232.         return 1, $status, $r;
  233.     }
  234.     if ($r->code eq 404) {
  235.         &log("GET $url conditional ok: ".$status);
  236.         return 1, 'CONDITIONAL: '.$status, $r;
  237.     }
  238.     &log("GET $url code fatal: ".$r->header('Client-Warning')." ".$status);
  239.     return 0, $status, $r;
  240. }
  241.  
  242. sub write_in_cache {
  243.     my $state=shift;
  244.     my $url=shift;
  245.     my $comment=shift||'';
  246.     my $r=shift||0;
  247.     my $ts=time()+(($state)?43200:3600);
  248.     my $sth = $dbh->prepare("INSERT INTO cache (url,is_verified,expiry,cipher,issuer,subject,comment) VALUES (?,?,?,?,?,?,?)") || die;
  249.     my ($cipher,$issuer,$subject);
  250.     if ($r) {
  251.         $cipher=$r->header('client-ssl-cipher');
  252.         $issuer=$r->header('client-ssl-cert-issuer');
  253.         $subject=$r->header('client-ssl-cert-subject');
  254.     }
  255.     $sth->execute(
  256.         $url,
  257.         $state,
  258.         $ts,
  259.         $cipher,
  260.         $issuer,
  261.         $subject,
  262.         $comment) || die;
  263. }
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top