tpb/common.pl

#!/opt/bin/perl

BEGIN {
   $ENV{http_proxy}  =
   $ENV{https_proxy} = "http://127.0.0.1:8118"; # privoxy
}

use common::sense;
use Compress::LZF;
use EV;
use AnyEvent::HTTP;
use BDB;
use Coro;
use Coro::BDB;
use AnyEvent::DNS;
use Set::IntSpan;
use CBOR::XS;
use Compress::Zlib ();
use Compress::Raw::Zlib ();
use AnyEvent::TLS;

BDB::min_parallel 8;

#our @TPB = qw(https://thepiratebay.org);
#our @TPB = qw(https://baypirateproxy.org);
our @TPB = qw(http://uj3wazyk5u4hnvtk.onion);
our $TPB = $TPB[0];

our $TODAY = int time / 86400;

#our $TPB_SWITCHER = AE::timer 1, 0.02, sub {
#   state $i;
#   $TPB = $TPB[++$i % @TPB];
#};

#############################################################################

$AnyEvent::HTTP::MAX_PER_HOST =
$AnyEvent::HTTP::MAX_PERSISTENT_PER_HOST = 400;

our %stat;

our $statprint = AE::timer 1, 1, sub {
   syswrite STDOUT, "\r" . (join " ", map "$_=$stat{$_}", sort keys %stat) . " "
      if $ENV{VERBOSE};
};

our @DICTIONARY = (do {
   open my $fh, "<:perlio", "dictionary0"
      or die "dictionary0: $!";
   local $/;
   <$fh>
});

#############################################################################

our $db_env = db_env_create;

$db_env->set_flags (BDB::AUTO_COMMIT | BDB::TXN_WRITE_NOSYNC, 1);
$db_env->log_set_config (BDB::LOG_AUTO_REMOVE);
#$db_env->set_cachesize (0, 8 * 1024 * 1024);
$db_env->set_cachesize (0, 512 * 1024);
$db_env->set_lk_max_lockers (20480);
$db_env->set_lk_max_locks (20480);
$db_env->set_lk_max_objects (20480);

mkdir "db", 0777;
db_env_open
  $db_env,
  "db",
  BDB::INIT_LOCK | BDB::INIT_LOG | BDB::INIT_MPOOL
  | BDB::INIT_TXN | BDB::RECOVER | BDB::REGISTER | BDB::USE_ENVIRON | BDB::CREATE,
  0666;

our %DB;

sub table($) {
   my $db = $DB{$_[0]} = db_create $db_env;
   db_open $db, undef, $_[0], undef, BDB::BTREE, BDB::AUTO_COMMIT | BDB::CREATE, 0666;
   die if $!;
   $db
}

our $db_state = table "state"; # global state
our $db_info  = table "info"; # per torrent state

our $TXN;

sub get($$) {
   db_get $_[0], $TXN, $_[1], my $data, 0;
   $data # will be undef on error
}

sub put($$$) {
   db_put $_[0], $TXN, $_[1], $_[2], 0;
}

sub del($$) {
   db_del $_[0], $TXN, $_[1], 0, sub { };
}

sub sget($) {
   get $db_state, $_[0]
}

sub sput($$) {
   put $db_state, $_[0], $_[1];
}

sub iget($) {
   my $data = get $db_info, $_[0];
   length $data ? decode_cbor $data : []
}

sub iput($$) {
   put $db_info, $_[0], encode_cbor $_[1];
}

our $syncer = AE::timer 5, 60, sub {
   db_env_txn_checkpoint $db_env, 0, 0, 0, sub { };
};

sub dbsync() {
   db_env_txn_checkpoint $db_env;
}

sub dbflush {
   return if $::dbflush_called++;
   db_env_txn_checkpoint $db_env, sub { };
   BDB::set_sync_prepare undef;
   db_close $_ for values %DB;
   db_env_txn_checkpoint $db_env;
   db_env_close $db_env;
}

END {
   dbflush;
}

sub quit {
   EV::unloop;
   #exit 1;
};

our $sigint  = AE::signal INT  => \&quit;
our $sigterm = AE::signal TERM => \&quit;

sub dic_compress($$) {
   my $d = new Compress::Raw::Zlib::Deflate
      -Level        => 9,
      -WindowBits   => -15,
      -Dictionary   => $DICTIONARY[$_[0]],
      -AppendOutput => 1,
   ;

   my $o;

   $d->deflate ($_[1], $o);
   $d->flush ($o);

   $o
}

sub dic_decompress($$) {
   my $i = new Compress::Raw::Zlib::Inflate
      -WindowBits   => -15,
      -Dictionary   => $DICTIONARY[$_[0]],
      -AppendOutput => 1,
      -ConsumeInput => 0,
   ;

   $i->inflate ($_[1], my $o, 1);

   $o
}

#############################################################################

#############################################################################

sub GET {
   my ($data, $hdr);

   for (1..50) {
      http_get $_[0],
         #proxy => undef,
         recurse => 0,
         headers => {
            "user-agent" => "Mozilla/5.0 (X11; Linux x86_64; rv:20.0) Gecko/20100101 Firefox/20.0 Iceweasel/20.0",
            "referer" => undef,
         },
         Coro::rouse_cb;
      ($data, $hdr) = Coro::rouse_wait;

      $hdr->{Status} = 404
         if $data =~ /You're looking for something that does not, has not, will not, might not or must not exist/;

      $hdr->{Status} = 580
         if $data =~ /^(?:Upgrading software|Could not connect to caching server|Database maintenance, please check back in 10 minutes)/;

      $hdr->{Status} = 581
         unless length $data;

      $data = Compress::Zlib::memGunzip $data
         if $hdr->{"content-encoding"} eq "gzip";

      last
         if $hdr->{Status} < 500;

      Coro::AnyEvent::sleep 1.5 if $hdr->{Satus} == 503;
      Coro::AnyEvent::sleep 9.5 if $hdr->{Satus} == 580;

      Coro::AnyEvent::sleep 0.5;
      ++$stat{"retry-$hdr->{Status}"};

#      use Data::Dump; ddx $hdr;#d#
   }

   ++$stat{$hdr->{Status}};
   ($data, $hdr)
}

1

Revision:	1.5
Committed:	Fri Aug 17 21:18:14 2018 UTC (5 years, 9 months ago) by root
Content type:	text/plain
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.4:	+10 -6 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/opt/bin/perl
2
3	root	1.5	BEGIN {
4			$ENV{http_proxy} =
5			$ENV{https_proxy} = "http://127.0.0.1:8118"; # privoxy
6			}
7
8	root	1.1	use common::sense;
9			use Compress::LZF;
10			use EV;
11			use AnyEvent::HTTP;
12			use BDB;
13			use Coro;
14			use Coro::BDB;
15			use AnyEvent::DNS;
16			use Set::IntSpan;
17			use CBOR::XS;
18			use Compress::Zlib ();
19			use Compress::Raw::Zlib ();
20			use AnyEvent::TLS;
21
22			BDB::min_parallel 8;
23
24	root	1.5	#our @TPB = qw(https://thepiratebay.org);
25			#our @TPB = qw(https://baypirateproxy.org);
26			our @TPB = qw(http://uj3wazyk5u4hnvtk.onion);
27	root	1.1	our $TPB = $TPB[0];
28
29			our $TODAY = int time / 86400;
30
31			#our $TPB_SWITCHER = AE::timer 1, 0.02, sub {
32			# state $i;
33			# $TPB = $TPB[++$i % @TPB];
34			#};
35
36			#############################################################################
37
38			$AnyEvent::HTTP::MAX_PER_HOST =
39			$AnyEvent::HTTP::MAX_PERSISTENT_PER_HOST = 400;
40
41			our %stat;
42
43			our $statprint = AE::timer 1, 1, sub {
44			syswrite STDOUT, "\r" . (join " ", map "$_=$stat{$_}", sort keys %stat) . " "
45			if $ENV{VERBOSE};
46			};
47
48			our @DICTIONARY = (do {
49			open my $fh, "<:perlio", "dictionary0"
50			or die "dictionary0: $!";
51			local $/;
52			<$fh>
53			});
54
55			#############################################################################
56
57			our $db_env = db_env_create;
58
59			$db_env->set_flags (BDB::AUTO_COMMIT \| BDB::TXN_WRITE_NOSYNC, 1);
60			$db_env->log_set_config (BDB::LOG_AUTO_REMOVE);
61	root	1.4	#$db_env->set_cachesize (0, 8 * 1024 * 1024);
62	root	1.5	$db_env->set_cachesize (0, 512 * 1024);
63	root	1.1	$db_env->set_lk_max_lockers (20480);
64			$db_env->set_lk_max_locks (20480);
65			$db_env->set_lk_max_objects (20480);
66
67			mkdir "db", 0777;
68			db_env_open
69			$db_env,
70			"db",
71			BDB::INIT_LOCK \| BDB::INIT_LOG \| BDB::INIT_MPOOL
72			\| BDB::INIT_TXN \| BDB::RECOVER \| BDB::REGISTER \| BDB::USE_ENVIRON \| BDB::CREATE,
73			0666;
74
75			our %DB;
76
77			sub table($) {
78			my $db = $DB{$_[0]} = db_create $db_env;
79			db_open $db, undef, $_[0], undef, BDB::BTREE, BDB::AUTO_COMMIT \| BDB::CREATE, 0666;
80			die if $!;
81			$db
82			}
83
84			our $db_state = table "state"; # global state
85			our $db_info = table "info"; # per torrent state
86
87			our $TXN;
88
89			sub get($$) {
90			db_get $_[0], $TXN, $_[1], my $data, 0;
91			$data # will be undef on error
92			}
93
94			sub put($$$) {
95			db_put $_[0], $TXN, $_[1], $_[2], 0;
96			}
97
98			sub del($$) {
99			db_del $_[0], $TXN, $_[1], 0, sub { };
100			}
101
102			sub sget($) {
103			get $db_state, $_[0]
104			}
105
106			sub sput($$) {
107			put $db_state, $_[0], $_[1];
108			}
109
110			sub iget($) {
111			my $data = get $db_info, $_[0];
112			length $data ? decode_cbor $data : []
113			}
114
115			sub iput($$) {
116			put $db_info, $_[0], encode_cbor $_[1];
117			}
118
119	root	1.4	our $syncer = AE::timer 5, 60, sub {
120	root	1.1	db_env_txn_checkpoint $db_env, 0, 0, 0, sub { };
121			};
122
123			sub dbsync() {
124			db_env_txn_checkpoint $db_env;
125			}
126
127			sub dbflush {
128			return if $::dbflush_called++;
129			db_env_txn_checkpoint $db_env, sub { };
130			BDB::set_sync_prepare undef;
131			db_close $_ for values %DB;
132			db_env_txn_checkpoint $db_env;
133			db_env_close $db_env;
134			}
135
136			END {
137			dbflush;
138			}
139
140			sub quit {
141			EV::unloop;
142			#exit 1;
143			};
144
145			our $sigint = AE::signal INT => \&quit;
146			our $sigterm = AE::signal TERM => \&quit;
147
148			sub dic_compress($$) {
149			my $d = new Compress::Raw::Zlib::Deflate
150			-Level => 9,
151			-WindowBits => -15,
152			-Dictionary => $DICTIONARY[$_[0]],
153			-AppendOutput => 1,
154			;
155
156			my $o;
157
158			$d->deflate ($_[1], $o);
159			$d->flush ($o);
160
161			$o
162			}
163
164			sub dic_decompress($$) {
165			my $i = new Compress::Raw::Zlib::Inflate
166			-WindowBits => -15,
167			-Dictionary => $DICTIONARY[$_[0]],
168			-AppendOutput => 1,
169			-ConsumeInput => 0,
170			;
171
172			$i->inflate ($_[1], my $o, 1);
173
174			$o
175			}
176
177			#############################################################################
178
179			#############################################################################
180
181			sub GET {
182			my ($data, $hdr);
183
184	root	1.4	for (1..50) {
185	root	1.1	http_get $_[0],
186	root	1.5	#proxy => undef,
187	root	1.1	recurse => 0,
188			headers => {
189	root	1.4	"user-agent" => "Mozilla/5.0 (X11; Linux x86_64; rv:20.0) Gecko/20100101 Firefox/20.0 Iceweasel/20.0",
190	root	1.1	"referer" => undef,
191			},
192			Coro::rouse_cb;
193			($data, $hdr) = Coro::rouse_wait;
194
195	root	1.4	$hdr->{Status} = 404
196			if $data =~ /You're looking for something that does not, has not, will not, might not or must not exist/;
197
198	root	1.1	$hdr->{Status} = 580
199	root	1.4	if $data =~ /^(?:Upgrading software\|Could not connect to caching server\|Database maintenance, please check back in 10 minutes)/;
200	root	1.1
201			$hdr->{Status} = 581
202			unless length $data;
203
204			$data = Compress::Zlib::memGunzip $data
205			if $hdr->{"content-encoding"} eq "gzip";
206
207			last
208			if $hdr->{Status} < 500;
209
210	root	1.4	Coro::AnyEvent::sleep 1.5 if $hdr->{Satus} == 503;
211			Coro::AnyEvent::sleep 9.5 if $hdr->{Satus} == 580;
212
213	root	1.1	Coro::AnyEvent::sleep 0.5;
214			++$stat{"retry-$hdr->{Status}"};
215	root	1.3
216			# use Data::Dump; ddx $hdr;#d#
217	root	1.1	}
218
219			++$stat{$hdr->{Status}};
220			($data, $hdr)
221			}
222
223			1
224