Subversion Repositories cms

Compare Revisions

Ignore whitespace Rev 7 → Rev 8

/trunk/test/SQUID/squid_redirect
12,9 → 12,7
# =============================================================== DEBUG
use Data::Dumper;
 
# utilizzo "C" per maggiore velocità nel confronto di stringhe
my $C_LANG=0;
 
# =============================================================== INIT
$0="squid_redirector";
$|=1;
 
24,14 → 22,17
|| die "DBI Error open database: ".DBI::errstr."\n";
$dbh->{RaiseError} = 1;
$dbh->do('set DateStyle to SQL, EUROPEAN');
#$dbh->{AutoCommit} = 0;
$dbh->{AutoCommit} = 1;
 
 
# =============================================================== LOG INIT
my $LOG='/var/log/squid_redirector.log';
open LOG, ">>$LOG" or die "on open file $LOG";
open LOG, ">>$LOG" or die "Errorr on open file $LOG";
select LOG;
$|=1;
my $sthlog = $dbh->prepare('insert into logs ("type", "user", ip, host, url) values (?, ?, ?, ?, ?)');
my $sth_InsertLog = $dbh->prepare('insert into logs ("type", "user", ip, host, url) values (?, ?, ?, ?, ?);');
my $sth_CheckLog = $dbh->prepare('select id, url, host from logs where id=(select max(id) from logs where "user" = ? and "type" = ?)');
my $sth_UpdateLog = $dbh->prepare('update logs set url=? where id=?;');
 
sub Log($$$$$){
my($type, $user, $ip, $host, $url) = @_;
38,18 → 39,56
chomp $url;
my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime();
my $time = sprintf("%04d/%02d/%02d %02d:%02d:%02d", 1900+$year, $mon+1, $mday, $hour, $min, $sec);
print LOG "$time $type $user $ip $host $url\n" or die "on print file $LOG";
$sthlog->execute($type, $user, $ip, $host, $url) || die "DBI Error inser logs: ".DBI::errstr."\n";
# $dbh->commit || die "DBI Error commit: ".DBI::errstr."\n";
$dbh->begin_work || warn "DBI Error begin_work: ".DBI::errstr." on Log()\n";
if($user && $user ne '-'){
# inserisco nel database solo una prima riga per accesso
$sth_CheckLog->execute($user, $type);
my @row = $sth_CheckLog->fetchrow_array();
if(@row && $host eq $row[2]){
my $p_url = $row[1];
if($p_url !~ m/$url/ && $url !~ m/[gif|jpeg|jpg|css]$/i && $p_url !~ m/\.\.\.$/){
# valuto la lunghezza del campo
if(length($p_url) + length($url) >= (256-5) ){
$p_url .= ' ...';
}else{
$p_url .= ' '.$url;
}
$sth_UpdateLog->execute($p_url, $row[0]) || warn "DBI Error inser logs: ".DBI::errstr."\n";
}
}else{
$sth_InsertLog->execute($type, $user, $ip, $host, $url) || warn "DBI Error inser logs: ".DBI::errstr."\n";
}
}else{
$sth_InsertLog->execute($type, $user, $ip, $host, $url) || warn "DBI Error inser logs: ".DBI::errstr."\n";
}
$dbh->commit || die "DBI Error commit: ".DBI::errstr."\n";
print LOG "$time $type $user $ip $host $url\n" or warn "on print file $LOG";
}
Log('log', $$, '-', '-', "Start squid_redirector $$");
 
# =============================================================== TRAP SIGNAL
sub Update{
Log('hup',$$, '-', '-', "Hangup $$; load new parameters");
&Update_keys;
$HUP_Semaphore = '';
 
sub GoUpdate(){
if($HUP_Semaphore && $HUP_Semaphore ne 'WAITING'){
Log('hup',$$, '-', '-', "load new parameters ");
&Update_keys;
}
$HUP_Semaphore='WAITING';
}
 
sub HandleUpdate{
my($sig) = @_;
if($HUP_Semaphore eq 'WAITING'){
$HUP_Semaphore=$sig;
# ritardo l'esecuzione di GoUpdate() ...
}else{
Log('hup',$$, '-', '-', "Hangup now $$; load new parameters");
&Update_keys;
$HUP_Semaphore='';
}
}
 
sub My_exit{
my($sig) = @_;
Log('err',$$, '-', '-', "Close $$ with signal $sig");
60,12 → 99,24
 
$SIG{INT} = \&My_exit;
$SIG{KILL} = \&My_exit;
$SIG{HUP} = \&Update;
$SIG{HUP} = \&HandleUpdate;
 
# lancia HUP ai processi fratelli
sub HUP_Family(){
$SIG{HUP} = sub {};
system '/usr/bin/su1', 'HUP_squid_redirector';
$SIG{HUP} = \&Update;
# individuo i PID dei processi fratelli
opendir DIR, "/proc/";
my $file;
while($file = readdir DIR){
if($file ne $$ && $file =~ m/\d+/){
if(open FILE, "</proc/$file/cmdline"){
if(<FILE> eq $0){
kill 1, $file;
}
close FILE;
}
}
}
closedir DIR;
}
 
# =============================================================== LOAD KEYS
75,9 → 126,12
my %SHARED;
 
sub Update_keys(){
$dbh->begin_work || warn "DBI Error begin_work: ".DBI::errstr." on Update_keys()\n";
$sthkeys->execute($lastkey);
$dbh->commit || die "DBI Error commit: ".DBI::errstr."\n";
while( my @row = $sthkeys->fetchrow_array ) {
$SHARED{$row[1]}=$row[2];
$SHARED{$row[1]}=~ s/^\s+//;
if($lastkey < $row[0]){
$lastkey = $row[0];
}
86,67 → 140,63
Update_keys();
 
# =============================================================== UPDATE KEYS
my $sthupdkeys = $dbh->prepare("update keys set id=?, value=? where key=?");
my $sthupdkeys = $dbh->prepare("update keys set id=?, value=? where key=?;");
 
if($C_LANG){
if(! -d '/var/lib/squid_redirector'){
mkdir '/var/lib/squid_redirector';
}
use Inline C => <<'END_C', DIRECTORY => '/var/lib/squid_redirector';
// =============================================================== TEST STRING in "C"
sub TestListStr($$){
my($LIST, $URL) = @_;
$LIST =~ s/^\s+//;
foreach my $key (split /\s+/, $LIST){
##print STDERR "test [$URL][$key]:".index($URL, $key)."\n";
if(index($URL, $key)>=0){
return 1;
}
}
return 0;
}
 
// cerca le stringhe contenute in LIST (separate da " " o "\n") in URL
int TestStr( char* LIST, char* URL){
char* WORD;
char EOL;
while(*LIST){
// tolgo blank iniziali
while(*LIST == ' ' || *LIST == '\n'){
LIST++;
}
WORD=LIST;
//cerco la fine della parola
while(*LIST && *LIST != ' ' && *LIST != '\n'){
LIST++;
}
if(*LIST){
EOL=*LIST;
*LIST='\0';
// verifico se la parola è contenuta nella URL
if(strstr(URL, WORD) == NULL){
return 1;
}
*LIST=EOL;
LIST++;
}else{
// verifico se la parola è contenuta nella URL
if(strstr(URL, WORD) == NULL){
return 1;
}
}
}
sub TestListStrEqual($$){
my($LIST, $URL) = @_;
$LIST =~ s/^\s+//;
foreach my $key (split /\s+/, $LIST){
if($URL eq $key){
return 1;
}
}
return 0;
}
END_C
}else{
eval <<'END_PERL';
# =============================================================== TEST STRING in Perl
sub TestStr($$){
 
 
sub OLDTestListStr($$){
my($LIST, $URL) = @_;
foreach my $key (split /\s+/, $LIST){
if($key && index($URL, $key)>=0){
if($URL =~ m/$key/){
return 1;
}
}
return 0;
}
END_PERL
}
 
############################################################### LOOP
WORD:
while (defined ($_=<STDIN>)){
while(1){
GoUpdate();
$HUP_Semaphore='';
last if(! defined($_=<STDIN>));
chomp;
my($url, $ip_fqdn, $ident, $method) = split;
 
##DEBUG
$ident='test';
 
$url || ($url='none');
$ip_fqdn || ($ip_fqdn='0');
$ident || ($ident='test');
$method || ($method='none');
 
###print STDERR "### $$ $ip_fqdn $ident $method [$url]\n";
 
GoUpdate();
 
my $ip = $ip_fqdn;
$ip =~ s|/.*||;
$url = 'none' if !$url;
157,9 → 207,9
$host =~ s|/.*||;
# =============================================================== FILTER WordList
# test presenza elenco parole in $host
if(TestStr($SHARED{WordList}, $lurl)){
if(TestListStr($SHARED{WordList}, $lurl)){
print STDOUT "301:about:blank\n";
Log('lock',$ident, $ip, $host, $url);
Log('lock', $ident, $ip, $host, $url);
next WORD;
}
if($host =~ m|^http://-/(.*)$|){
166,18 → 216,22
print LOG "$$ redir command $1\n";
$url =~ s|//-/|//127.0.0.1/|;
}
print STDOUT "$url\n";
Log(lc $method, $ident, $ip, $host, $url);
 
GoUpdate();
# =============================================================== FOLLOWME
# test se Docente di una Classe e FollowMe attivo
if(1){
if(!TestStr($SHARED{'FollowMe'}, $host)){
if(!TestListStrEqual($SHARED{'FollowMe'}, $host)){
$SHARED{'FollowMe'}.=" $host";
Log('log',$$, '-', '-', "Add FollowMe $host");
$dbh->begin_work || warn "DBI Error begin_work: ".DBI::errstr." on FollowMe update\n";
$sthupdkeys->execute(++$lastkey, $SHARED{'FollowMe'}, 'FollowMe');
$dbh->commit || die "DBI Error commit: ".DBI::errstr."\n";
# aggiorno anche gli altri processi
HUP_Family();
}
}
print STDOUT "$url\n";
Log(lc $method, $ident, $ip, $host, "$$ $url");
}
Log('log',$$, '-', '-', "Stop squid_redirector $$");