From cc7bf7991ff827c4b41c0cd7888a073b91f66827 Mon Sep 17 00:00:00 2001
From: Mark Dilger <mark.dilger@enterprisedb.com>
Date: Fri, 17 May 2024 10:24:11 -0700
Subject: [PATCH v1] Add a WIP corruption checker

To help analyze Alexander Korotkov's v3 series of patches, add a
corruption checker that runs an infinite loop corrupting an index
and seeing if the corruption is detected.

THIS IS NOT FOR COMMIT.
---
 contrib/amcheck/t/006_corrupt_idx.pl | 136 +++++++++++++++++++++++++++
 1 file changed, 136 insertions(+)
 create mode 100644 contrib/amcheck/t/006_corrupt_idx.pl

diff --git a/contrib/amcheck/t/006_corrupt_idx.pl b/contrib/amcheck/t/006_corrupt_idx.pl
new file mode 100644
index 0000000000..d27b0ff9b6
--- /dev/null
+++ b/contrib/amcheck/t/006_corrupt_idx.pl
@@ -0,0 +1,136 @@
+
+# Copyright (c) 2023-2024, PostgreSQL Global Development Group
+
+# This regression test checks the behavior of the btree validation in the
+# presence of breaking sort order changes.
+#
+use strict;
+use warnings FATAL => 'all';
+use PostgreSQL::Test::Cluster;
+use PostgreSQL::Test::Utils;
+use Test::More;
+use Fcntl 'SEEK_SET';
+
+my $node = PostgreSQL::Test::Cluster->new('test');
+$node->init;
+$node->append_conf('postgresql.conf', 'autovacuum = off');
+$node->start;
+
+# Create tables and indexes over some values
+$node->safe_psql('postgres',qq(
+CREATE EXTENSION amcheck;
+CREATE TABLE tbl (i TEXT);
+INSERT INTO tbl (SELECT 'MAGIC_' || gs::TEXT FROM generate_series(1,100000) gs ORDER BY RANDOM());
+CREATE UNIQUE INDEX idx ON tbl (i);
+));	
+
+my @blocks;
+
+while (1)
+{
+	my ($result, $stdout, $stderr);
+
+	$result = $node->safe_psql(
+		'postgres', q(
+		SELECT bt_index_parent_check('idx', true, true, true);
+	));
+	is($result, '', 'run amcheck on non-broken idx');
+
+	my $pgdata = $node->data_dir;
+	my $rel = $node->safe_psql('postgres',
+		qq(SELECT pg_relation_filepath('public.idx')));
+	my $relpath = "$pgdata/$rel";
+	$node->stop;
+
+	my ($blksize, @blocks) = read_blocks($relpath);
+
+	my $ttl = 1000;
+	my $corrupted_blkno = undef;
+	while (!defined($corrupted_blkno) && $ttl--)
+	{
+		my $blkno = int(rand(scalar(@blocks)-1));
+
+		if ($blocks[$blkno] =~ m/.*MAGIC_(\d+)/)
+		{
+			my $magic = $1;
+			my $corrupted_block = $blocks[$blkno];
+
+			my $next_magic = $magic + 1;
+			my $prev_magic = $magic - 1;
+			if ($next_magic >= 1 && $next_magic <= 100000 && $blocks[$blkno+1] =~ m/MAGIC_$next_magic/)
+			{
+				if ($corrupted_block =~ s/MAGIC_$magic/MAGIC_$next_magic/)
+				{
+					write_block($relpath, $blksize, $blkno, $corrupted_block);
+					$corrupted_blkno = $blkno;
+				}
+			}
+			elsif ($prev_magic >= 1 && $prev_magic <= 100000 && $blocks[$blkno+1] =~ m/MAGIC_$prev_magic/)
+			{
+				if ($corrupted_block =~ s/MAGIC_$magic/MAGIC_$prev_magic/)
+				{
+					write_block($relpath, $blksize, $blkno, $corrupted_block);
+					$corrupted_blkno = $blkno;
+				}
+			}
+		}
+	}
+
+	BAIL_OUT("Failed to corrupt anything") unless($ttl > 0);
+
+	# Ok, we've corrupted the file.  Restart the node and see if the
+	# corruption checker notices anything.
+	$node->start;
+
+	($result, $stdout, $stderr) = $node->psql(
+		'postgres', q(
+		SELECT bt_index_parent_check('idx', true, true, true);
+	));
+	ok( $stderr =~ /item order invariant violated for index "idx"|index uniqueness is violated for index "idx"|could not find tuple using search from root page in index "idx"|mismatch between parent key and child high key in index "idx"|detected uniqueness violation for index "idx"/);
+
+	# Repair the damage.
+	$node->stop;
+	write_block($relpath, $blksize, $corrupted_blkno, $blocks[$corrupted_blkno]);
+
+	# Restart the database and confirm the index is back to passing
+	$node->start;
+ 	$result = $node->safe_psql(
+		'postgres', q(
+		SELECT bt_index_check('idx', true, true);
+	));
+	is($result, '', 'run amcheck on non-broken idx');
+}
+
+# Not reached
+done_testing();
+
+sub read_blocks
+{
+	my ($relpath) = @_;
+	my $file;
+	open($file, '+<', $relpath)
+		or BAIL_OUT("open failed: $!");
+	binmode $file;
+	my ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat($file);
+
+	my @result;
+	for (my $blkno = 0; $blkno < $blocks; $blkno++)
+	{
+		sysseek($file, $blkno * $blksize, SEEK_SET);
+		sysread($file, $result[$blkno], $blksize);
+	}
+	close($file);
+	return ($blksize, @result);
+}
+
+sub write_block
+{
+	my ($relpath, $blksize, $blkno, $block) = @_;
+	my $file;
+	open($file, '+<', $relpath)
+		or BAIL_OUT("open failed: $!");
+	binmode $file;
+	sysseek($file, $blkno * $blksize, SEEK_SET);
+	syswrite($file, $block);
+	close($file);
+}
-- 
2.39.3 (Apple Git-145)