#!/usr/bin/perl
#
# showflaw.pl
#
# origionally by David Harris <dharris@drh.net>
# gensym-ized/ported to show corruption his dbm library by Stas Bekman <sbekman@iil.intel.com>
#

use strict;
use DB_File;
use Symbol;

my $dbname = "foo.db";

$| = 1;
&main;

sub LOCK_SH { 1 }
sub LOCK_EX { 2 }
sub LOCK_NB { 4 }
sub LOCK_UN { 8 }

sub thread_a
{
	print "thread_a: pid $$\n";

	## Get a lock on the database

	print "thread_a: attempting to open db and get lock\n";

	my %db_hash;
	my $db_obj = tie(%db_hash, "DB_File", $dbname, O_CREAT|O_RDWR, 0644)
		or die "thread_a: dbcreate $dbname $!";

	my $fd = $db_obj->fd;
	my $fh = gensym;
	open $fh, "+<&=$fd" or die "thread_a: fdopen $!";
	flock $fh, LOCK_EX  or die "thread_a: flock $!";

	## Wait five seconds

	print "thread_a: waiting five seconds\n";
	sleep(5);

	## Write a bunch of stuff to the database

	print "thread_a: writing 2000 records to the database\n";

	foreach my $a (1 .. 20) {
	  foreach my $b (1 .. 100) {
	    $db_hash{"A${a}a${b}"} = "A";
	  }
	}

	## Dump the database

	print "thread_a: dumping database to $dbname.dump01\n";

	my $dump_fh = gensym;
	open $dump_fh, ">$dbname.dump01" or die "thread_a: open $dbname.dump01 $!";
	foreach ( sort keys %db_hash ) {
		print $dump_fh "$_ = $db_hash{$_}\n";
	}
	close $dump_fh;

	## Release the lock

	print "thread_a: releasing lock\n";

	$db_obj->sync();
	flock $fh, LOCK_UN;
	undef $db_obj;
	untie(%db_hash);
	close $fh;

	## Exit

	print "thread_a: exiting\n";
	exit(0);
}

sub thread_b
{
	print "thread_b: pid $$\n";

	## Wait three seconds so when we try to get a lock, thread_a already has it

	print "thread_b: waiting three seconds\n";
	sleep(3);

	## Get a lock on the database
	print "thread_b: attempting to open db and get lock\n";

	my %db_hash;
	my $db_obj = tie(%db_hash, "DB_File", $dbname, O_CREAT|O_RDWR, 0644)
		or die "thread_b: dbcreate $dbname $!";

	my $fd = $db_obj->fd;
	my $fh = gensym;
	open $fh, "+<&=$fd" or die "thread_b: fdopen $!";
	flock $fh, LOCK_EX  or die "thread_b: flock $!";

	## Try to dump the database

	print "thread_b: dumping database to $dbname.dump02\n";

	my $dump_fh = gensym;
	open $dump_fh, ">$dbname.dump02" or die "thread_b: open $dbname.dump02 $!";
	foreach ( sort keys %db_hash ) {
		print $dump_fh "$_ = $db_hash{$_}\n";
	}
	close $dump_fh;

	## Write a bunch of stuff to the database

	print "thread_b: writing 400 records to the database\n";

	foreach my $a (1 .. 20) {
	  foreach my $b (1 .. 20) {
	    $db_hash{"B${a}b${b}"} = "B";
	  }
	}

	## Try to dump the database

	print "thread_b: dumping database to $dbname.dump03\n";

	$dump_fh = gensym;
	open $dump_fh, ">$dbname.dump03" or die "thread_b: open $dbname.dump03 $!";
	foreach ( sort keys %db_hash ) {
		print $dump_fh "$_ = $db_hash{$_}\n";
	}
	close $dump_fh;

	## Release the lock

	print "thread_b: releasing lock\n";

	$db_obj->sync();
	flock $fh, LOCK_UN;
	undef $db_obj;
	untie(%db_hash);
	close $fh;

	## Exit
	print "thread_b: exiting\n";
	exit(0);

}

sub main
{
	my %db_hash;
	my $db_obj;

	## Clear the database

	print "main: creating new empty database\n";
	
	unlink $dbname;
	$db_obj = tie(%db_hash, "DB_File", $dbname, O_CREAT|O_RDWR, 0644)
		or die "dbcreate $dbname $!";
	$db_hash{"first_record"} = "stuff";
	$db_obj->sync();
	untie(%db_hash);
	undef $db_obj;

	## Fork the two children
	print "main: forking threads and waiting for them\n";

	thread_a() unless fork();
	thread_b() unless fork();
	wait;
	wait;

	print "main: opening and dumping database to $dbname.dump04\n";

	$db_obj = tie(%db_hash, "DB_File", $dbname, O_CREAT|O_RDWR, 0644)
		or die "dbcreate $dbname $!";

	open DUMP, ">$dbname.dump04" or die "thread_b: open $dbname.dump04 $!";
	foreach ( sort keys %db_hash ) {
		print DUMP "$_ = $db_hash{$_}\n";
	}
	close DUMP;

	$db_obj->sync();
	untie(%db_hash);
	undef $db_obj;

	## Exit

#print `dd if=$dbname bs=1024 count=4 2>/dev/null | md5sum`;

	print "main: exiting\n";
	exit 0;

}