--- greylist	2005-01-17 22:38:07.000000000 +0900
+++ greylist.tarpit0_2	2007-03-24 23:36:53.000000000 +0900
@@ -63,6 +63,9 @@
 # location for ip files - must be writable by the relevent id (qmaild probably)
 my $base = "/var/qmail/greylist";
 
+# location for blacklist files
+my ${blacklist} = "/var/qmail/blacklist";
+
 # location for whitelist files (eg. yahoo groups - they don't retry!)
 my $whitelist = "/var/qmail/whitelist";
 
@@ -94,12 +97,30 @@
 # (rfc2821 recommends at least 5 minutes for most commands)
 my $smtptimeout = 5 * 60;
 
+# I perform tarpitting before demanding retransmission. 
+# I accept the host if connected even if I do tarpitting. 
+# This is one of the salvation to reduce a work load to add the SMTP server that is the justice that cannot transmit a message again to whitelist.
+# (this uses http://honyaku.yahoo.co.jp/transtext, and it is the sentence that it converted into English from Japanese)
+#  Do you perform tarpitting?
+#    0 -- No   (I am the same as movement of normal qgreylist)
+#    1 -- yes  (I carry out tarpitting before demanding retransmission from the host whom I do not know )
+#    2 -- yes  (I carry out tarpitting for all hosts before checking greylist. )
+my $tarpittingmode = 1;
+#   tarpit second
+my $tarpitsec = 65;
+#   If I do tarpit and do not disconnect, I receive an email
+#    0 -- after 450      1 -- accept
+my $tarpitwaitaccept = 1;
+
+my $remoteiptmp="";
+
 # greylist against entire class-c (/24) networks rather than IP addresses
 # if set to 1, greylist entire class-c networks rather than single IP addresses
 # this should help with clusters of mailservers which connect from separate
 # IP addresses with each delivery attempt (eg. yahoo groups)
 my $greylistclassc = 1;
 
+
 sub set_mtime
 {
 	my ( $file ) = @_;
@@ -326,6 +347,37 @@
 	}
 }
 
+sub tarpitting {
+	
+	my ( ${remoteip} ) = @_;
+	
+	${remoteiptmp} = ${remoteip};
+	
+	$SIG{'INT'} = $SIG{'TERM'} = $SIG{'HUP'} = $SIG{'ABRT'} = "sigexit_tarpit";
+	
+	syslog "info", "IP %s new - tarpitting start", $remoteip if $verbose;
+	sleep ${tarpitsec};
+	
+	$SIG{'INT'} = $SIG{'TERM'} = $SIG{'HUP'} = $SIG{'ABRT'} = "";
+	
+	if ( ${tarpitwaitaccept} == 1 ) {
+		syslog "info", "IP %s OK - tarpit waited accepting", $remoteip if $verbose;
+		run_next_stage;
+	}
+	syslog "info", "IP %s new - tarpitting end", $remoteip if $verbose;
+}
+
+sub sigexit_tarpit {
+	
+	syslog "info", "IP %s NG - tarpit can't wait", $remoteiptmp if $verbose;
+	exit;
+}
+
+sub stmp_deny_fail {
+	print "550 denied";
+	print "421 $domain Bye";
+	exit;
+}
 
 
 # ------------------------------------------------------------
@@ -381,6 +433,17 @@
 
 #my $mtime = -M $checkfile;
 
+# add -- NG - blacklisted IPs
+if ( check_ip ${blacklist}, $remoteip ) {
+	syslog "info", "IP %s NG - blacklisted ", $remoteip if $verbose;
+	stmp_deny_fail;
+}
+
+# add -- tarpitting
+if ( $tarpittingmode == 2 ) {
+	tarpitting $remoteip;
+}
+
 my ( $atime, $mtime ) = check_ip $base, $remoteip;
 
 if ( ! defined $mtime )
@@ -389,6 +452,11 @@
 
 	syslog "info", "IP %s new - temp error", $remoteip if $verbose;
 
+	# add -- tarpitting
+	if ( $tarpittingmode == 1 ) {
+		tarpitting $remoteip;
+	}
+
 	# touch the file so we remember this IP for next time
 	set_mtime $checkfile;