bitjoe - MutellaProxy - MutellaProxy - SOURCE CODE

#!/usr/bin/perl

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	16.07.2006
##### Function:		MD5 Checksum erstellen		
##### Todo:			
########################################

package MutellaProxy::CheckSum;

# use Digest::MD5 qw(md5 md5_hex md5_base64);

use Digest::MD5 qw( md5_hex );
use Digest::MD4 qw( md4_hex );
use Digest::SHA1 qw( sha1_hex );

use strict;

my $VERSION = '0.18';


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # sub new() {}


sub MD5ToHEX(){

	my $self	= shift;
	my $String	= shift;
	
	if ( ref($String) eq 'SCALAR' ) {
		return md5_hex( ${$String} );
	} elsif ( ref($String) eq '' ) {
		return md5_hex( $String );
	};

}; # sub md5_hex(){}


sub MD4ToHEX(){

	my $self	= shift;
	my $String	= shift;
	

... [truncated, 24 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	13.07.2006
##### Function:		
##### Todo:			DEFAULT in encrypt und decrypt lschen!!
########################################

package MutellaProxy::CryptoLibrary;

use MutellaProxy::CheckSum;
use MutellaProxy::Time;
use MutellaProxy::SQL;
use Crypt::Rijndael;
use Crypt::CBC;
use strict;

my $VERSION			= '0.22.1';

sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub GetPrivateCryptoKeyFromDatabase(){

	my $self		= shift;
	my $PublicKey	= shift;

	RESTART:

	$@ ='';
	undef $@;

	my $sth;
	my $sth2;
	my $DBHandle;
	my $ResultHashRef;
	
	eval {

		$DBHandle = MutellaProxy::SQL->SQLConnect();

		$sth = $DBHandle->prepare( qq { SELECT * FROM `Crypto` WHERE `PUBLICKEY` = "$PublicKey" AND `VALIDUNTIL` >= CURDATE() LIMIT 1; } );
		$sth->execute;

... [truncated, 182 more lines] ...

package MutellaProxy::Daemon;

#########################################
##### Author:		Lincoln Stein
##### CopyRight:	GPL
##### LastModified	11.07.2006
##### Function:		Daemon Fhigkeiten des Servers		
##### Todo:			
########################################

use strict;
use vars qw(@EXPORT @ISA @EXPORT_OK $VERSION);

use POSIX qw(:signal_h setsid WNOHANG);
use Carp 'croak','cluck';
use Carp::Heavy;
use File::Basename;
use IO::File;
use Cwd;
use Sys::Syslog qw(:DEFAULT setlogsock);
require Exporter;

@EXPORT_OK = qw(init_server prepare_child kill_children 
                launch_child do_relaunch
                log_debug log_notice log_warn 
                log_die %CHILDREN);
@EXPORT = @EXPORT_OK;
@ISA = qw(Exporter);
my $VERSION = '1.00';

use constant PIDPATH  => '/var/run';
use constant FACILITY => 'local0';
use vars qw(%CHILDREN);
my ($pid,$pidfile,$saved_dir,$CWD);

sub init_server {
  my ($user,$group);
  ($pidfile,$user,$group) = @_;
  $pidfile ||= getpidfilename();
  my $fh = open_pid_file($pidfile);
  become_daemon();
  print $fh $$;
  close $fh;
  init_log();
  change_privileges($user,$group) if defined $user && defined $group;
  return $pid = $$;
};

sub become_daemon {
  croak "Can't fork" unless defined (my $child = fork);

... [truncated, 121 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	11.07.2006
##### Function:		Debuggin Infomationen sammeln		
##### Todo:			
########################################

package MutellaProxy::Debug;

my $VERSION = '0.17';

use MutellaProxy::Time;
use Data::Dumper;
use strict;


my $DEBUGFILE	= '/server/mutella/DEBUG/DebugMessages.txt';


sub new() {
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub Debugging(){

	my $self				= shift;
	my $RefObj				= shift || 'MutellaProxy::Object';
	my $Dumper				= shift;
	my $ManualEditedText	= shift || '';
	my $Typ					= shift;

	if ( $Typ ne 'SCREEN' ) {
	
		my $MySQLDateTime = MutellaProxy::Time->MySQLDateTime();
		open(DEBUG,"+>>$DEBUGFILE") or sub { warn "MutellaProxy::Debug->Debugging(): IO ERROR: $!\n"; return -1; };
			flock (DEBUG, 2);
				print DEBUG "########## Entry from $MySQLDateTime ### RefObj $RefObj ##########\n";
				print DEBUG "########## Manual Text: $ManualEditedText ########################\n";
				print DEBUG Dumper( $Dumper );
				print DEBUG "##################################################################\n";
		close DEBUG;

	}; 

... [truncated, 7 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian | modified 27.07.06 Torsten
##### CopyRight:	BitJoe GmbH
##### LastModified	27.07.06
##### Function:		Dateitypen definieren
##### Todo:			
########################################

package MutellaProxy::FileTypes;

use strict;

my $VERSION = '0.18';


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()
  

sub BilderFileTypes(){

	my %BilderFileTypes = (
		1 => 'jpg', # first is default
		2 => 'jpeg',
		3 => 'png',
		4 => 'gif',
		5 => 'bmp',
		6 => 'tiff',
		7 => 'svg',
		8 => 'jpa',
		9 => 'tif',		
	);

	return \%BilderFileTypes;

};	# sub BilderFileTypes(){}


sub MP3FileTypes(){

	my %MP3FileTypes = (
		1 => 'mp3', # first is default
		2 => 'wma',
		3 => 'mp2',

... [truncated, 84 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	27.07.2006
##### Function:		verschiede Filter fr die Results
##### Todo:			
########################################

package MutellaProxy::Filter;

# use String::Approx 'amatch';
use MutellaProxy::IO;
use strict;


#	FORMATBILD=200K
#	FORMATMP3=6M
#	FORMATRING=200K
#	FORMATVIDEO=15M
#	FORMATJAVA=350K
#	FORMATDOC=500K


my $SIZEFILTER	= '/server/mutella/FILTER/sizefilter.dat';


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # sub new(){}


sub SizeFilter(){

	my $self				= shift;
	my $type				= shift;
	my $GivenSizeInBytes	= shift;

	my $ContentArrayRef		= MutellaProxy::IO->ReadFileIntoArray( $SIZEFILTER );

	my $multiply;

	foreach my $entry ( @{$ContentArrayRef} ) {
		
		next if ( $entry =~ /^#/ );


... [truncated, 46 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Patrick Canterino / Sebastian Enger / B.Sc
##### CopyRight:	2003 Patrick Canterino / since 2006 BitJoe GmbH
##### LastModified	11.07.2006
##### Function:		Gzip (De)Compression of Files/Strings
##### Todo:			Testing
########################################

package MutellaProxy::Gzip;


use MutellaProxy::CryptoLibrary;
use MutellaProxy::CheckSum;
use base qw(Exporter);
use MutellaProxy::IO;
use strict;


my $VERSION = '0.10';

use vars qw( @EXPORT
            $gzippath);

### Export ###
@EXPORT = qw(
			gzip_compress
            gzip_decompress
			gzip_compress_string
			gzip_decompress_string
			);


# Constructor
sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


# Pfad zum GZip-Programm (erreichbar ueber $GZip::gzippath)
my $gzippath = '/bin/gzip';
my $temppath = '/server/mutella/tmp';


# ============================
#  Zugriff mit Compress::Zlib

... [truncated, 323 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	16.07.2006
##### Function:		IO spezifisches Modul
##### Todo:			
########################################

package MutellaProxy::IO;

my $VERSION = '0.19.1';

# use IO::Socket::SSL qw(debug4);

use MutellaProxy::CryptoLibrary;
use MutellaProxy::CheckSum;
use IO::Socket;
use strict;


use constant UNIXSOCKET		=> '/server/mutella/socket';
use constant RANDOM_DEVICE	=> '/dev/urandom';
use constant MAXINCBYTES	=> 50 * 1024 * 1024;	# 10 mbytes


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub readSocket() {
	
	my $self	= shift;
	my $socket	= shift;
	
	my $IO;
	my $STREAM;
	my $StreamCount = 0;

	binmode($socket);

	while (sysread($socket , $IO, 1) == 1) {
		
		if ( $StreamCount == MAXINCBYTES ) {
			# breche ab, wenn mehr als MAXINCBYTES Bytes in einer Session an den Server gesendet wurden

... [truncated, 228 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	16.07.2006
##### Function:		IO spezifisches Modul
##### Todo:			
########################################

package MutellaProxy::IOSSL;

my $VERSION = '0.19.1';

use IO::Socket::SSL;
use IO::Socket;
use strict;


use constant UNIXSOCKET		=> '/server/mutella/socket';
use constant RANDOM_DEVICE	=> '/dev/urandom';
use constant MAXINCBYTES	=> 50 * 1024 * 1024;	# 10 mbytes


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub readSocket() {
	
	my $self	= shift;
	my $socket	= shift;
	
	my $IO;
	my $STREAM;
	my $StreamCount = 0;

	while (sysread($socket , $IO, 1) == 1) {
		
		if ( $StreamCount == MAXINCBYTES ) {
			# breche ab, wenn mehr als MAXINCBYTES Bytes in einer Session an den Server gesendet wurden
			print "WARNING: Possible Denial of Service Attack - more than " .MAXINCBYTES. " Bytes of incoming Traffic!\n";
			$STREAM = '';
			exit(0);
		};
		

... [truncated, 222 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	16.07.2006
##### Function:		IP Filter fr die Results
##### Todo:			
########################################

package MutellaProxy::IPFilter;
use strict;

my $VERSION		= '0.18.1';

my $REALOADFILE = '/server/mutella/IPFILTER/reload.txt';
my $IPFILTER	= '/server/mutella/IPFILTER/ipfilter.dat';
my $TMPFILTER	= '/server/mutella/IPFILTER/tempfilter.txt';
my $IPBLOCKER	= '/server/mutella/IPFILTER/ipblocker.txt';	# eine IP pro Zeile


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # sub new(){}


sub IPBlocker(){

	my $self	= shift;
	my $GivenIP	= shift;

	open(BLOCKER, "<$IPBLOCKER") or sub { warn "MutellaProxy::IPFilter->IPBlocker(): Blocking not possible: IO ERROR: $!\n"; return -1; };
		flock (BLOCKER, 2);
		while( defined( my $IPperLine = <BLOCKER> ) ){
			$IPperLine =~ s/[\s]//g;
			if ( $IPperLine eq $GivenIP || $IPperLine == $GivenIP ) {
				close BLOCKER;
				return -1; # sind equal
			}; # if ( $IPperLine eq
		}; # while 
	close BLOCKER;

	return 0;	# nicht gleich, wenn kein Match

}; # sub IPBlocker(){}



... [truncated, 188 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	16.07.2006
##### Function:		Lizenzen generieren
##### Todo:			
########################################

package MutellaProxy::LicenceGenerator;
  
use MutellaProxy::CryptoLibrary;
use MutellaProxy::CheckSum;
use MutellaProxy::Mutella;
use MutellaProxy::Debug;
use MutellaProxy::Time;
use MutellaProxy::SQL;
use strict;


my $VERSION				= '0.21.0';
my $LICENCESTOREPATH	= '/server/mutella/LICENCE';	  # later Config

# diese werte mssen ensprechend gendert werden
my $ClientCurrentMin	= "1.0";
my $ClientCurrentMax	= "1.1";


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub GenerateALLLicenceForToday(){

	my $self			= shift;
	my $Licence			= $self->GenerateLicence();		
	my $PUBLICKEY		= $self->GenerateLicence();		
	my $PRIVATEKEY		= $self->GenerateLicence();	
	my $ValidUntil		= MutellaProxy::Time->GetValid8DayDateForLicence();
	my $MySQLDateTime	= MutellaProxy::Time->MySQLDateTime();

	my $LICENCE=<<END_OF_SQL;
INSERT DELAYED INTO `Licence` ( `UNID` , `LICENCE` , `CMIN` , `CMAX` , `VALIDUNTIL` , `FORMATBILD` , `FORMATMP3` , `FORMATRING` , `FORMATVIDEO` , `FORMATJAVA` , `FORMATDOC` , `ADDED` , `HITS` ) VALUES ( "", "$Licence", "$ClientCurrentMin", "$ClientCurrentMax", "$ValidUntil", "1", "1", "1", "1", "1", "1", "$MySQLDateTime", "0");
END_OF_SQL


... [truncated, 647 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	12.07.2006
##### Function:		LicenceManagement
##### Todo:			
########################################

package MutellaProxy::LicenceManagement;

use MutellaProxy::FileTypes;
use MutellaProxy::SQL;
use strict;


my $VERSION = '0.17.1';

sub new() {
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub CheckLicence(){
	
	my $self				= shift;
	my $ArrayRef			= shift;
		
	my $WishedFileType		= $ArrayRef->[1];
	my $Licence				= $ArrayRef->[3];
	my $ClientVersion		= $ArrayRef->[4];
	
	my $AllowedLicenceFlag	= 0;
	my $AllowedClientFlag	= 0;
	my $AllowedFileTypeFlag = 0;

	my $CurrentFileType		= {};
	my $FileTypeHashRef		= {};
	my $ResultHashRef;		# wird beim sql query dann mit werten gefllt
	my $DBHandle;
	my $FileType;
	my $sth;

	RESTARTONE:
	$@ ='';
	undef $@;

... [truncated, 148 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	16.07.2006
##### Function:		LicenceTransfer
##### Todo:			
########################################


# my $scpe = Net::SCP::Expect->new(host=>'85.214.59.105', user=>'root', password=>'PQdfqZHr');
# $scpe->auto_yes(1);
# $scpe->scp('/server/mutella/MutellaProxy_V0.1.9.pl','root@85.214.59.105:/root/');

package MutellaProxy::LicenceTransfer;

use MutellaProxy::CryptoLibrary;
use MutellaProxy::CheckSum;
use MutellaProxy::Mail;
use MutellaProxy::Time;
use MutellaProxy::SQL;
use MutellaProxy::IO;
use Net::SCP::Expect;		#  perl -MCPAN -e 'install "Net::SCP::Expect"' 
use strict;

my $VERSION				= '0.20.1';
my $LICENCEPATH			= '/server/mutella/LICENCE';				# todo: config auslesen
my $CRYPTOLICENCEPATH	= '/server/mutella/LICENCE/ENCRYPTED';	# todo: config auslesen
my $DECRYPTEDLICENCEPATH= '/server/mutella/LICENCE/DECRYPTED';

my $CRYPTOKEY			= '12341234123412341234123412342341';	# todo: config auslesen


# Definiere einen Config Hash - hier stehen alle Username,Passwords u. Hostnames drinne, zu denen die verschlsselten Daten bertragen werden sollen
my %ConfigHash =(
	"1"	=> my $CfG1 = { 
			"HOST"	=> "85.214.59.105",
			"USER"	=> "root",
			"PASS"	=> "PQdfqZHr",
			"PATH"	=> "/server/mutella/"
			},
#	"2"	=> my $CfG2 = { 
#			"HOST"	=> "HOSTIP",
#			"USER"	=> "USERNAME",
#			"PASS"	=> "PASSWORD",
#			"PATH"	=> "/root/.mutella"	 # wo soll es gespeichert werden
#			}, 
);


... [truncated, 367 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	11.07.2006
##### Function:		Logging
##### Todo:			logging ^^
########################################

package MutellaProxy::Logging;

my $VERSION = '0.17';

use MutellaProxy::Time;
use strict;

my $LOGINIT		= '/server/mutella/LOGS/INITLOG.txt';
my $LOGRESULTS	= '/server/mutella/LOGS/GETRESULTSLOG.txt';
my $LOGSTARTDL	= '/server/mutella/LOGS/STARTDOWNLOADLOG.txt';
my $LOGENDDL	= '/server/mutella/LOGS/FINISHDOWNLOADLOG.txt';
my $LOGLICENCE	= '/server/mutella/LOGS/INVALIDLICENCELOG.txt';

#use IO::Handle;

sub new() {
	
	my $self = bless {}, shift;
	return $self;
		
}; # new();


sub LogToFileInit(){
	
	my $self			= shift;
	my $LogScalarRef	= shift;
	my $Hostname		= shift;
	my $IpAdress		= shift;

	#	$hostinfo->name || $client->peerhost;

	my ( $type, $flag, $IMEI, $LicenceKey, $ClientVersion, $SearchQuery , $FileType , $JavaVersion, $HandyModel , $MobilePhoneProvider, $ResultID ) = split("\r\n", ${$LogScalarRef}); 
	my $UnixTimeStamp = time();
	my $MySQLDateTime = MutellaProxy::Time->MySQLDateTime();

	# later: open(LOG,"+>>/logs/log") or doSQLLogs()

	open(LOG,"+>>$LOGINIT") or sub { warn "MutellaProxy::Logging->LogToFileInit(): IO ERROR: $!\n"; return -1; };
		flock (LOG, 2);

... [truncated, 197 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	14.07.2006
##### Function:		Mail
##### Todo:			
########################################

package MutellaProxy::Mail;

use MIME::Lite; #  perl -MCPAN -e 'install "MIME::Lite"'
use strict;

# Variablendefinition
my $MailTo		 = 'thecerial@gmail.com';
my $MailTo2		 = '', #'torsten.morgenroth@gmail.com';
my $MailFrom     = 'root@zoozle.net';
my $MailSubject  = 'MutellaProxy::Mail';
my $MailBody     = 'HOSTNAME: zoozle.net ';	# later: bestimme den hostname und sende ihn mit


my $VERSION			= '0.17.1';


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub SendMail(){

	return 1;

	my $self		= shift;
	my $MailHashRef = shift;

    my $msg = MIME::Lite->new(
                 From     => $MailHashRef->{'FROM'} || $MailFrom,
                 To       => $MailHashRef->{'TO1'} || $MailTo,
                 Cc       => $MailHashRef->{'TO2'} || $MailTo2,
                 Subject  => $MailHashRef->{'SUBJECT'} || $MailSubject,
                 Type     => 'text/plain',
				 Data     => $MailBody . $MailHashRef->{'BODY'} || $MailBody,
                # Encoding =>'base64',
                # Path     =>'hellonurse.gif'

... [truncated, 10 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	12.07.2006
##### Function:		Mutella spezifische Funktionen
##### Todo:			
########################################

package MutellaProxy::Mutella;

use MutellaProxy::Parser;
use MutellaProxy::IO;
use strict;

my $VERSION = '0.19.5';

use constant FIND_COMMAND	=> "find ";	
use constant LIST_COMMAND	=> "list \n"; 
use constant DELETE_COMMAND	=> "delete ";	
use constant OPEN_COMMAND	=> "open ";
use constant INFO_COMMAND	=> "info \n";

use constant CRLF			=> "\r\n";
my $ULTRAPEERLIST			= "http://www.zoozle.net/projekt24-testXASDQasdfqwe42/ultrapeers.txt";


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub getResultID(){

	my $self			= shift;
	my $MutellaSocket	= shift || MutellaProxy::IO->CreateMutellaSocket();
	my $SEARCH			= shift;

	my $listHashRef		= MutellaProxy::Parser->ListCommandParser( $MutellaSocket );

	for my $value ( keys %{$listHashRef} ) {
		my $ListSearch = $listHashRef->{ $value }->{ 'SEARCH' };
		# wenn suchanfrage gleich dem eintrag in der mutella liste, dann gib die result id zurck
		if ( lc($SEARCH) eq lc($ListSearch) ) {
			return $value;
		};

... [truncated, 55 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	27.07.2006
##### Function:		Parsing von Daten
##### Todo:			
########################################

package MutellaProxy::Parser;

use MutellaProxy::SpamFilter;
use MutellaProxy::IPFilter;
use MutellaProxy::Filter;
use MutellaProxy::IO;
use strict;

use constant LIST_COMMAND		=> "list \n"; 
use constant RESULTS_COMMAND	=> "results "; 
use constant INFO_COMMAND		=> "info \n";
use constant CLOSE_COMMAND		=> "close ";

my $VERSION = '0.22.5';

my $SpeedRankingPointsforModem	= 1;
my $SpeedRankingPointsforISDN	= 2;
my $SpeedRankingPointsforDSL	= 4;
my $SpeedRankingPointsforCable	= 4;
my $SpeedRankingPointsforT1		= 6;
my $SpeedRankingPointsforT3		= 7;


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub CheckSharingRatio(){

	my $self			= shift;
	my $MutellaSocket	= shift || MutellaProxy::IO->CreateMutellaSocket();

	my $list;

	while ( length($list) == 0 ) {
		MutellaProxy::IO->writeSocket( $MutellaSocket, INFO_COMMAND );

... [truncated, 395 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	11.07.2006
##### Function:		Cache die Results
##### Todo:			 readCache(){}
########################################


# cache fr cache.bild:mp3:java eine separate datei anlegen und beim cacheRead auch nur aus dieser datei lesen


package MutellaProxy::ResultCache;

use MutellaProxy::IO;
use IO::Handle;
use strict;

my $VERSION		= '0.18.1';
my $CACHEPATH	= '/server/mutella/CACHE';
my $CACHEVALIDTIME	= 168;	# in hours = 7 tage



sub new() {
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub readCache(){

	my $self			= shift;
	my $ReadCacheFrom	= shift;
	my $ReadCacheTo		= shift;
	my $SearchQuery		= shift;
	my $FileTypeHashRef = shift;

	# my $KeyCount		= keys( %{$FileTypeHashRef} );
	# my $FileTyp			= $FileTypeHashRef->{$KeyCount};
	my $FileTyp			= $FileTypeHashRef->{ 1 };

	$SearchQuery		=~ s/\s/\+/g;
	$SearchQuery		= lc($SearchQuery);

	my $SendString		= '';

... [truncated, 59 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	17.07.2006
##### Function:		Daten fr das Lschen von veralteten Suchbegriffen
##### Todo:			
########################################

package MutellaProxy::ResultCleaner;

use MutellaProxy::Mutella;
use MutellaProxy::Parser;
use MutellaProxy::IO;
use strict;

my $FILERESULTSTORE		= '/server/mutella/RESULTS/ResultCleaner.txt';
my $STOREOLDRESULTS		= '/server/mutella/RESULTS/OldResults.txt';
my $CacheValidForSec	= '200';
my $VERSION				= '0.17';


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub writeResultFile(){

	my $self	= shift;
	my $Search	= shift;

	my $time	= time();

	open(CLEANER,"+>>$FILERESULTSTORE") or sub { warn "MutellaProxy::ResultCleaner->writeResultFile(): IO ERROR: $!\n"; return -1; };
		flock (CLEANER, 2);
		print CLEANER "$Search#$time\n";
	close CLEANER;

	return 1;

}; # sub writeResultFile(){}


sub DeleteEntryRange(){


... [truncated, 75 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	11.07.2006
##### Function:		SQL Verbindungen aufbauen
##### Todo:			
########################################

package MutellaProxy::SQL;

use DBI;
use strict;

my $VERSION = '0.17';

### later: alles aus config lesen  
my $HOST	= "localhost";
my $DB		= "GnutellaProxy";
my $USER	= "root";
my $PASS	= "xfZYKWuu";


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub SQLConnect(){

	my $self	= shift;
	my $drh		= DBI->install_driver("mysql");
	my $dbh		= DBI->connect("DBI:mysql:database=$DB;host=$HOST", "$USER", "$PASS", {'RaiseError' => 0});
	return $dbh;

};	# sub SQLConnect(){}


return 1;

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	27.07.2006
##### Function:		Sortierung und Punktevergabe fr die Ergebnisse
##### Todo:			hits vergabe / nach speed sortieren
########################################

# Hinweis: bei einer neueren Version von Sort::Array kann es sein, das beim sortieren nicht ein zustzliches zeichen angehngt wird,
# sodass das chop entfernt werden muss im mutellaproxy.pl !

package MutellaProxy::SortRank;

use Sort::Array qw( Sort_Table );
use String::Approx 'amatch';
use MutellaProxy::Debug;
use File::Basename;
use strict;

my $VERSION = '0.22.1';

my $KeywordMatchingMultiply		= 5;
my $NegativMatchingQuantifier	= -100;
my $ApproxMatchingQuantifier	= "40%";
my $MaxSourcesForOneHit			= 20;
my $MaxScanningDepth			= 1000;


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub SortRank(){
	
	my $self			= shift;
	my $ResultHashRef	= shift;
	my $SearchQuery		= shift;
	my $FileTypeHashRef = shift;

	my $KeyWordMatching			= 0;
	my $SortedHashRef			= {};
	my $SortedHashRefCounter	= 0;
	my @UNSORTED				= ();
	my @SORTED					= ();

... [truncated, 284 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	27.07.2006
##### Function:		Sortierung und Punktevergabe fr die Ergebnisse
##### Todo:			hits vergabe / nach speed sortieren
########################################

# Hinweis: bei einer neueren Version von Sort::Array kann es sein, das beim sortieren nicht ein zustzliches zeichen angehngt wird,
# sodass das chop entfernt werden muss im mutellaproxy.pl !

package MutellaProxy::SortRank;

use Sort::Array qw( Sort_Table );
use String::Approx 'amatch';
use MutellaProxy::Debug;
use File::Basename;
use strict;

my $VERSION = '0.22.1';

my $KeywordMatchingMultiply		= 5;
my $NegativMatchingQuantifier	= -100;
my $ApproxMatchingQuantifier	= "40%";
my $MaxSourcesForOneHit			= 20;
my $MaxScanningDepth			= 1000;


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub SortRank(){
	
	my $self			= shift;
	my $ResultHashRef	= shift;
	my $SearchQuery		= shift;
	my $FileTypeHashRef = shift;

	my $KeyWordMatching			= 0;
	my $SortedHashRef			= {};
	my $SortedHashRefCounter	= 0;
	my @UNSORTED				= ();
	my @SORTED					= ();

... [truncated, 286 more lines] ...

#!/usr/bin/perl -I/server/mutella/MutellaProxy
package PhexProxy::PhexSortRank;

package MutellaProxy::SortRank;

use Sort::Array qw( Sort_Table );
use String::Approx 'amatch';
use MutellaProxy::Debug;
use File::Basename;
use strict;

# hinweis: momentan wird die unteren for iteration nur 20 mal durchgegangen!
#use integer;

my $MaxFileLength				= 10000;
my $KeywordMatchingMultiply		= 5;
my $NegativMatchingQuantifier	= -100;
my $ApproxMatchingQuantifier	= "40%";
my $MaxSourcesForOneHit			= 5;
#my $MaxScanningDepth			= 1000;


# speed related Things
my $SpeedRankingPointsforModem	= 1;
my $SpeedRankingPointsforISDN	= 2;
my $SpeedRankingPointsforDSL	= 4;
my $SpeedRankingPointsforCable	= 4;
my $SpeedRankingPointsforT1		= 6;
my $SpeedRankingPointsforT3		= 7;

my $IsSpeedModem				= 56;	
my $IsSpeedISDN					= 64;
my $IsSpeedDSL					= 1024;
my $IsSpeedCable				= 2048;
my $IsSpeedT1					= 4096;
my $IsSpeedT3					= 6144;


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()



sub SortRank(){
	
	my $self			= shift;

... [truncated, 368 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	27.07.2006
##### Function:		verschiede Filter fr die Results
##### Todo:			
########################################

package MutellaProxy::SpamFilter;

use strict;


sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # sub new(){}


sub SpamFilter(){

	my $self		= shift;
	my $ScalarRef	= shift;
	my $SearchQuery	= shift;
	$SearchQuery	= lc($SearchQuery);
	
	if ( ${$ScalarRef} =~ /[(\w)|(\d)|(\s)]+\.(com|net|org|biz|de|info|tv|vu|eu|at|ch)/i) {
		return -1;	# sind equal
	} elsif ( ${$ScalarRef} =~ /[(\w)|(\d)|(\s)]+\.(zip|arj|rar|exe|com)/i) {
		return -1;	# sind equal
	} elsif ( ${$ScalarRef} eq "$SearchQuery-xxx.wmv" || ${$ScalarRef} =~ /$SearchQuery-xxx\.wmv/i ) {
		return -1;	# sind equal
	} elsif ( ${$ScalarRef} eq "$SearchQuery.wmv" || ${$ScalarRef} =~ /$SearchQuery\.wmv/i ) {
		return -1;	# sind equal
	};

	return 0;
	
};  # sub UrlFilter(){}


return 1;

#!/usr/bin/perl -I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	17.07.2006
##### Function:		Server Status Flag auswerten
##### Todo:			
########################################

package MutellaProxy::Status;

use MutellaProxy::IO;
use strict;

my $VERSION		= '0.17';
my $StatusFile	= '/server/mutella/STATUS/StatusFile.txt';

sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()

sub readStatus(){

	# Status=1:		working correctly
	# Status=-1:	bin busy und nehme keine verbindungen mehr an

	my $Status = MutellaProxy::IO->ReadFileIntoScalar( $StatusFile );
	$Status = ${$Status};

	if ( $Status eq '-1' || $Status =~ /-1/ ) {
		return -1;
	} elsif ( $Status eq '0' || $Status =~ /0/ ) {
		return -1;
	} elsif ( $Status eq '1' || $Status =~ /1/ ) {
		return 1;
	};	

	# default gebe working correctly zurck
	return 1;

}; # sub readStatus(){}


return 1;

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	11.07.2006
##### Function:		Zeitspezifische Daten
##### Todo:			
########################################

package MutellaProxy::Time;

use MutellaProxy::SQL;
use strict;

my $VERSION			= '0.17.1';
my $LicenceIsValid	= "8";		# SELECT DATE_ADD( CURDATE( ) , INTERVAL 8 DAY ); 
								# SELECT DATE_ADD( CURDATE( ) , INTERVAL $LicenceIsValid DAY )

sub new() {
	
	my $self = bless {}, shift;
	return $self;
		
}; # new()


sub GetValid8DayDateForLicence(){

	my $self		= shift;
	my $DBHandle	= MutellaProxy::SQL->SQLConnect();
	
	my $sth	= $DBHandle->prepare( qq { SELECT DATE_ADD( CURDATE( ) , INTERVAL $LicenceIsValid DAY ) AS `DATE` LIMIT 1; } );
	$sth->execute;
	my $ResultHashRef = $sth->fetchrow_hashref;
	$sth->finish;

	return $ResultHashRef->{ 'DATE' };
	
}; # sub GetValid8DayDateForLicence(){}

	  
sub GetCurrentTimeStamp(){

	return time();

}; # sub GetCurrentTimeStamp(){}


sub MySQLDateTime() {

... [truncated, 44 more lines] ...

#!/usr/bin/perl	-I/server/mutella/MutellaProxy

#########################################
##### Author:		Sebastian Enger / B.Sc
##### CopyRight:	BitJoe GmbH
##### LastModified	12.07.2006
##### Function:		Mutella spezifische Funktionen
##### Todo:			
########################################

package MutellaProxy::Ultrapeers;

use MutellaProxy::Parser;
use MutellaProxy::Time;
use MutellaProxy::IO;
use Net::Nslookup;
use LWP::Simple;
use strict;

my $VERSION = '0.19.5';

use constant FIND_COMMAND	=> "find ";	
use constant LIST_COMMAND	=> "list \n"; 
use constant DELETE_COMMAND	=> "delete ";	
use constant OPEN_COMMAND	=> "open ";
use constant INFO_COMMAND	=> "info \n";

use constant CRLF			=> "\r\n";


my $ULTRAPEERLIST			= "http://www.alpha64.info/cachelist.txt";
my $ULTRAPEERS				= "/var/www/gwebcache/data/hosts_gnutella.dat";
my $HOSTPATH				= "/server/mutella/hosts.save";

$Net::Nslookup::MX_IS_NUMERIC = 1;
$Net::Nslookup::TIMEOUT		  = 1;

sub new(){
	
	my $self = bless {}, shift;
	return $self;
		
}; # new(){}


sub GetAndInstallUltraPeerHostList(){

	my $self				= shift;
	my $UltraPeerInstallTry = shift || 0;
	

... [truncated, 231 more lines] ...

my @files = glob("*.pm");

my $lineCount = 0;

foreach my $file (@files) {
	open(RH,"<$file");
		while(<RH>){
			$lineCount++;
		};
	close RH;
};

print "$lineCount Zeilen Code\n";

sleep 2;