PostgreSQL Source Code  git master
verify_nbtree.c
Go to the documentation of this file.
1 /*-------------------------------------------------------------------------
2  *
3  * verify_nbtree.c
4  * Verifies the integrity of nbtree indexes based on invariants.
5  *
6  * For B-Tree indexes, verification includes checking that each page in the
7  * target index has items in logical order as reported by an insertion scankey
8  * (the insertion scankey sort-wise NULL semantics are needed for
9  * verification).
10  *
11  * When index-to-heap verification is requested, a Bloom filter is used to
12  * fingerprint all tuples in the target index, as the index is traversed to
13  * verify its structure. A heap scan later uses Bloom filter probes to verify
14  * that every visible heap tuple has a matching index tuple.
15  *
16  *
17  * Copyright (c) 2017-2024, PostgreSQL Global Development Group
18  *
19  * IDENTIFICATION
20  * contrib/amcheck/verify_nbtree.c
21  *
22  *-------------------------------------------------------------------------
23  */
24 #include "postgres.h"
25 
26 #include "access/htup_details.h"
27 #include "access/nbtree.h"
28 #include "access/table.h"
29 #include "access/tableam.h"
30 #include "access/transam.h"
31 #include "access/xact.h"
32 #include "catalog/index.h"
33 #include "catalog/pg_am.h"
34 #include "catalog/pg_opfamily_d.h"
35 #include "commands/tablecmds.h"
36 #include "common/pg_prng.h"
37 #include "lib/bloomfilter.h"
38 #include "miscadmin.h"
39 #include "storage/lmgr.h"
40 #include "storage/smgr.h"
41 #include "utils/guc.h"
42 #include "utils/memutils.h"
43 #include "utils/snapmgr.h"
44 
45 
47 
48 /*
49  * A B-Tree cannot possibly have this many levels, since there must be one
50  * block per level, which is bound by the range of BlockNumber:
51  */
52 #define InvalidBtreeLevel ((uint32) InvalidBlockNumber)
53 #define BTreeTupleGetNKeyAtts(itup, rel) \
54  Min(IndexRelationGetNumberOfKeyAttributes(rel), BTreeTupleGetNAtts(itup, rel))
55 
56 /*
57  * State associated with verifying a B-Tree index
58  *
59  * target is the point of reference for a verification operation.
60  *
61  * Other B-Tree pages may be allocated, but those are always auxiliary (e.g.,
62  * they are current target's child pages). Conceptually, problems are only
63  * ever found in the current target page (or for a particular heap tuple during
64  * heapallindexed verification). Each page found by verification's left/right,
65  * top/bottom scan becomes the target exactly once.
66  */
67 typedef struct BtreeCheckState
68 {
69  /*
70  * Unchanging state, established at start of verification:
71  */
72 
73  /* B-Tree Index Relation and associated heap relation */
76  /* rel is heapkeyspace index? */
78  /* ShareLock held on heap/index, rather than AccessShareLock? */
79  bool readonly;
80  /* Also verifying heap has no unindexed tuples? */
82  /* Also making sure non-pivot tuples can be found by new search? */
84  /* Also check uniqueness constraint if index is unique */
86  /* Per-page context */
88  /* Buffer access strategy */
90 
91  /*
92  * Info for uniqueness checking. Fill these fields once per index check.
93  */
96 
97  /*
98  * Mutable state, for verification of particular page:
99  */
100 
101  /* Current target page */
103  /* Target block number */
105  /* Target page's LSN */
107 
108  /*
109  * Low key: high key of left sibling of target page. Used only for child
110  * verification. So, 'lowkey' is kept only when 'readonly' is set.
111  */
113 
114  /*
115  * The rightlink and incomplete split flag of block one level down to the
116  * target page, which was visited last time via downlink from target page.
117  * We use it to check for missing downlinks.
118  */
121 
122  /*
123  * Mutable state, for optional heapallindexed verification:
124  */
125 
126  /* Bloom filter fingerprints B-Tree index */
128  /* Debug counter */
131 
132 /*
133  * Starting point for verifying an entire B-Tree index level
134  */
135 typedef struct BtreeLevel
136 {
137  /* Level number (0 is leaf page level). */
139 
140  /* Left most block on level. Scan of level begins here. */
142 
143  /* Is this level reported as "true" root level by meta page? */
146 
149 
150 static void bt_index_check_internal(Oid indrelid, bool parentcheck,
151  bool heapallindexed, bool rootdescend,
152  bool checkunique);
153 static inline void btree_index_checkable(Relation rel);
154 static inline bool btree_index_mainfork_expected(Relation rel);
155 static void bt_check_every_level(Relation rel, Relation heaprel,
156  bool heapkeyspace, bool readonly, bool heapallindexed,
157  bool rootdescend, bool checkunique);
159  BtreeLevel level);
161  BlockNumber start,
162  BTPageOpaque start_opaque);
164  BlockNumber btpo_prev_from_target,
165  BlockNumber leftcurrent);
168  BlockNumber block, OffsetNumber offset,
169  int posting, ItemPointer nexttid,
170  BlockNumber nblock, OffsetNumber noffset,
171  int nposting);
173  BlockNumber targetblock,
174  OffsetNumber offset, int *lVis_i,
175  ItemPointer *lVis_tid,
176  OffsetNumber *lVis_offset,
177  BlockNumber *lVis_block);
180  OffsetNumber *rightfirstoffset);
181 static void bt_child_check(BtreeCheckState *state, BTScanInsert targetkey,
182  OffsetNumber downlinkoffnum);
184  OffsetNumber target_downlinkoffnum,
185  Page loaded_child,
186  uint32 target_level);
187 static void bt_downlink_missing_check(BtreeCheckState *state, bool rightsplit,
188  BlockNumber blkno, Page page);
190  Datum *values, bool *isnull,
191  bool tupleIsAlive, void *checkstate);
193  IndexTuple itup);
194 static inline IndexTuple bt_posting_plain_tuple(IndexTuple itup, int n);
195 static bool bt_rootdescend(BtreeCheckState *state, IndexTuple itup);
196 static inline bool offset_is_negative_infinity(BTPageOpaque opaque,
197  OffsetNumber offset);
199  OffsetNumber upperbound);
200 static inline bool invariant_leq_offset(BtreeCheckState *state,
202  OffsetNumber upperbound);
204  OffsetNumber lowerbound);
207  BlockNumber nontargetblock,
208  Page nontarget,
209  OffsetNumber upperbound);
212  IndexTuple itup);
214  Page page, OffsetNumber offset);
216  IndexTuple itup, bool nonpivot);
218 
219 /*
220  * bt_index_check(index regclass, heapallindexed boolean, checkunique boolean)
221  *
222  * Verify integrity of B-Tree index.
223  *
224  * Acquires AccessShareLock on heap & index relations. Does not consider
225  * invariants that exist between parent/child pages. Optionally verifies
226  * that heap does not contain any unindexed or incorrectly indexed tuples.
227  */
228 Datum
230 {
231  Oid indrelid = PG_GETARG_OID(0);
232  bool heapallindexed = false;
233  bool checkunique = false;
234 
235  if (PG_NARGS() >= 2)
236  heapallindexed = PG_GETARG_BOOL(1);
237  if (PG_NARGS() == 3)
238  checkunique = PG_GETARG_BOOL(2);
239 
240  bt_index_check_internal(indrelid, false, heapallindexed, false, checkunique);
241 
242  PG_RETURN_VOID();
243 }
244 
245 /*
246  * bt_index_parent_check(index regclass, heapallindexed boolean, rootdescend boolean, checkunique boolean)
247  *
248  * Verify integrity of B-Tree index.
249  *
250  * Acquires ShareLock on heap & index relations. Verifies that downlinks in
251  * parent pages are valid lower bounds on child pages. Optionally verifies
252  * that heap does not contain any unindexed or incorrectly indexed tuples.
253  */
254 Datum
256 {
257  Oid indrelid = PG_GETARG_OID(0);
258  bool heapallindexed = false;
259  bool rootdescend = false;
260  bool checkunique = false;
261 
262  if (PG_NARGS() >= 2)
263  heapallindexed = PG_GETARG_BOOL(1);
264  if (PG_NARGS() >= 3)
265  rootdescend = PG_GETARG_BOOL(2);
266  if (PG_NARGS() == 4)
267  checkunique = PG_GETARG_BOOL(3);
268 
269  bt_index_check_internal(indrelid, true, heapallindexed, rootdescend, checkunique);
270 
271  PG_RETURN_VOID();
272 }
273 
274 /*
275  * Helper for bt_index_[parent_]check, coordinating the bulk of the work.
276  */
277 static void
278 bt_index_check_internal(Oid indrelid, bool parentcheck, bool heapallindexed,
279  bool rootdescend, bool checkunique)
280 {
281  Oid heapid;
282  Relation indrel;
283  Relation heaprel;
284  LOCKMODE lockmode;
285  Oid save_userid;
286  int save_sec_context;
287  int save_nestlevel;
288 
289  if (parentcheck)
290  lockmode = ShareLock;
291  else
292  lockmode = AccessShareLock;
293 
294  /*
295  * We must lock table before index to avoid deadlocks. However, if the
296  * passed indrelid isn't an index then IndexGetRelation() will fail.
297  * Rather than emitting a not-very-helpful error message, postpone
298  * complaining, expecting that the is-it-an-index test below will fail.
299  *
300  * In hot standby mode this will raise an error when parentcheck is true.
301  */
302  heapid = IndexGetRelation(indrelid, true);
303  if (OidIsValid(heapid))
304  {
305  heaprel = table_open(heapid, lockmode);
306 
307  /*
308  * Switch to the table owner's userid, so that any index functions are
309  * run as that user. Also lock down security-restricted operations
310  * and arrange to make GUC variable changes local to this command.
311  */
312  GetUserIdAndSecContext(&save_userid, &save_sec_context);
313  SetUserIdAndSecContext(heaprel->rd_rel->relowner,
314  save_sec_context | SECURITY_RESTRICTED_OPERATION);
315  save_nestlevel = NewGUCNestLevel();
317  }
318  else
319  {
320  heaprel = NULL;
321  /* Set these just to suppress "uninitialized variable" warnings */
322  save_userid = InvalidOid;
323  save_sec_context = -1;
324  save_nestlevel = -1;
325  }
326 
327  /*
328  * Open the target index relations separately (like relation_openrv(), but
329  * with heap relation locked first to prevent deadlocking). In hot
330  * standby mode this will raise an error when parentcheck is true.
331  *
332  * There is no need for the usual indcheckxmin usability horizon test
333  * here, even in the heapallindexed case, because index undergoing
334  * verification only needs to have entries for a new transaction snapshot.
335  * (If this is a parentcheck verification, there is no question about
336  * committed or recently dead heap tuples lacking index entries due to
337  * concurrent activity.)
338  */
339  indrel = index_open(indrelid, lockmode);
340 
341  /*
342  * Since we did the IndexGetRelation call above without any lock, it's
343  * barely possible that a race against an index drop/recreation could have
344  * netted us the wrong table.
345  */
346  if (heaprel == NULL || heapid != IndexGetRelation(indrelid, false))
347  ereport(ERROR,
349  errmsg("could not open parent table of index \"%s\"",
350  RelationGetRelationName(indrel))));
351 
352  /* Relation suitable for checking as B-Tree? */
353  btree_index_checkable(indrel);
354 
355  if (btree_index_mainfork_expected(indrel))
356  {
357  bool heapkeyspace,
358  allequalimage;
359 
360  if (!smgrexists(RelationGetSmgr(indrel), MAIN_FORKNUM))
361  ereport(ERROR,
362  (errcode(ERRCODE_INDEX_CORRUPTED),
363  errmsg("index \"%s\" lacks a main relation fork",
364  RelationGetRelationName(indrel))));
365 
366  /* Extract metadata from metapage, and sanitize it in passing */
367  _bt_metaversion(indrel, &heapkeyspace, &allequalimage);
368  if (allequalimage && !heapkeyspace)
369  ereport(ERROR,
370  (errcode(ERRCODE_INDEX_CORRUPTED),
371  errmsg("index \"%s\" metapage has equalimage field set on unsupported nbtree version",
372  RelationGetRelationName(indrel))));
373  if (allequalimage && !_bt_allequalimage(indrel, false))
374  {
375  bool has_interval_ops = false;
376 
377  for (int i = 0; i < IndexRelationGetNumberOfKeyAttributes(indrel); i++)
378  if (indrel->rd_opfamily[i] == INTERVAL_BTREE_FAM_OID)
379  has_interval_ops = true;
380  ereport(ERROR,
381  (errcode(ERRCODE_INDEX_CORRUPTED),
382  errmsg("index \"%s\" metapage incorrectly indicates that deduplication is safe",
383  RelationGetRelationName(indrel)),
384  has_interval_ops
385  ? errhint("This is known of \"interval\" indexes last built on a version predating 2023-11.")
386  : 0));
387  }
388 
389  /* Check index, possibly against table it is an index on */
390  bt_check_every_level(indrel, heaprel, heapkeyspace, parentcheck,
391  heapallindexed, rootdescend, checkunique);
392  }
393 
394  /* Roll back any GUC changes executed by index functions */
395  AtEOXact_GUC(false, save_nestlevel);
396 
397  /* Restore userid and security context */
398  SetUserIdAndSecContext(save_userid, save_sec_context);
399 
400  /*
401  * Release locks early. That's ok here because nothing in the called
402  * routines will trigger shared cache invalidations to be sent, so we can
403  * relax the usual pattern of only releasing locks after commit.
404  */
405  index_close(indrel, lockmode);
406  if (heaprel)
407  table_close(heaprel, lockmode);
408 }
409 
410 /*
411  * Basic checks about the suitability of a relation for checking as a B-Tree
412  * index.
413  *
414  * NB: Intentionally not checking permissions, the function is normally not
415  * callable by non-superusers. If granted, it's useful to be able to check a
416  * whole cluster.
417  */
418 static inline void
420 {
421  if (rel->rd_rel->relkind != RELKIND_INDEX ||
422  rel->rd_rel->relam != BTREE_AM_OID)
423  ereport(ERROR,
424  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
425  errmsg("only B-Tree indexes are supported as targets for verification"),
426  errdetail("Relation \"%s\" is not a B-Tree index.",
427  RelationGetRelationName(rel))));
428 
429  if (RELATION_IS_OTHER_TEMP(rel))
430  ereport(ERROR,
431  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
432  errmsg("cannot access temporary tables of other sessions"),
433  errdetail("Index \"%s\" is associated with temporary relation.",
434  RelationGetRelationName(rel))));
435 
436  if (!rel->rd_index->indisvalid)
437  ereport(ERROR,
438  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
439  errmsg("cannot check index \"%s\"",
441  errdetail("Index is not valid.")));
442 }
443 
444 /*
445  * Check if B-Tree index relation should have a file for its main relation
446  * fork. Verification uses this to skip unlogged indexes when in hot standby
447  * mode, where there is simply nothing to verify. We behave as if the
448  * relation is empty.
449  *
450  * NB: Caller should call btree_index_checkable() before calling here.
451  */
452 static inline bool
454 {
455  if (rel->rd_rel->relpersistence != RELPERSISTENCE_UNLOGGED ||
457  return true;
458 
459  ereport(DEBUG1,
460  (errcode(ERRCODE_READ_ONLY_SQL_TRANSACTION),
461  errmsg("cannot verify unlogged index \"%s\" during recovery, skipping",
462  RelationGetRelationName(rel))));
463 
464  return false;
465 }
466 
467 /*
468  * Main entry point for B-Tree SQL-callable functions. Walks the B-Tree in
469  * logical order, verifying invariants as it goes. Optionally, verification
470  * checks if the heap relation contains any tuples that are not represented in
471  * the index but should be.
472  *
473  * It is the caller's responsibility to acquire appropriate heavyweight lock on
474  * the index relation, and advise us if extra checks are safe when a ShareLock
475  * is held. (A lock of the same type must also have been acquired on the heap
476  * relation.)
477  *
478  * A ShareLock is generally assumed to prevent any kind of physical
479  * modification to the index structure, including modifications that VACUUM may
480  * make. This does not include setting of the LP_DEAD bit by concurrent index
481  * scans, although that is just metadata that is not able to directly affect
482  * any check performed here. Any concurrent process that might act on the
483  * LP_DEAD bit being set (recycle space) requires a heavyweight lock that
484  * cannot be held while we hold a ShareLock. (Besides, even if that could
485  * happen, the ad-hoc recycling when a page might otherwise split is performed
486  * per-page, and requires an exclusive buffer lock, which wouldn't cause us
487  * trouble. _bt_delitems_vacuum() may only delete leaf items, and so the extra
488  * parent/child check cannot be affected.)
489  */
490 static void
491 bt_check_every_level(Relation rel, Relation heaprel, bool heapkeyspace,
492  bool readonly, bool heapallindexed, bool rootdescend,
493  bool checkunique)
494 {
496  Page metapage;
497  BTMetaPageData *metad;
498  uint32 previouslevel;
499  BtreeLevel current;
500  Snapshot snapshot = SnapshotAny;
501 
502  if (!readonly)
503  elog(DEBUG1, "verifying consistency of tree structure for index \"%s\"",
505  else
506  elog(DEBUG1, "verifying consistency of tree structure for index \"%s\" with cross-level checks",
508 
509  /*
510  * This assertion matches the one in index_getnext_tid(). See page
511  * recycling/"visible to everyone" notes in nbtree README.
512  */
514 
515  /*
516  * Initialize state for entire verification operation
517  */
518  state = palloc0(sizeof(BtreeCheckState));
519  state->rel = rel;
520  state->heaprel = heaprel;
521  state->heapkeyspace = heapkeyspace;
522  state->readonly = readonly;
523  state->heapallindexed = heapallindexed;
524  state->rootdescend = rootdescend;
525  state->checkunique = checkunique;
526  state->snapshot = InvalidSnapshot;
527 
528  if (state->heapallindexed)
529  {
530  int64 total_pages;
531  int64 total_elems;
532  uint64 seed;
533 
534  /*
535  * Size Bloom filter based on estimated number of tuples in index,
536  * while conservatively assuming that each block must contain at least
537  * MaxTIDsPerBTreePage / 3 "plain" tuples -- see
538  * bt_posting_plain_tuple() for definition, and details of how posting
539  * list tuples are handled.
540  */
541  total_pages = RelationGetNumberOfBlocks(rel);
542  total_elems = Max(total_pages * (MaxTIDsPerBTreePage / 3),
543  (int64) state->rel->rd_rel->reltuples);
544  /* Generate a random seed to avoid repetition */
546  /* Create Bloom filter to fingerprint index */
547  state->filter = bloom_create(total_elems, maintenance_work_mem, seed);
548  state->heaptuplespresent = 0;
549 
550  /*
551  * Register our own snapshot in !readonly case, rather than asking
552  * table_index_build_scan() to do this for us later. This needs to
553  * happen before index fingerprinting begins, so we can later be
554  * certain that index fingerprinting should have reached all tuples
555  * returned by table_index_build_scan().
556  */
557  if (!state->readonly)
558  {
560 
561  /*
562  * GetTransactionSnapshot() always acquires a new MVCC snapshot in
563  * READ COMMITTED mode. A new snapshot is guaranteed to have all
564  * the entries it requires in the index.
565  *
566  * We must defend against the possibility that an old xact
567  * snapshot was returned at higher isolation levels when that
568  * snapshot is not safe for index scans of the target index. This
569  * is possible when the snapshot sees tuples that are before the
570  * index's indcheckxmin horizon. Throwing an error here should be
571  * very rare. It doesn't seem worth using a secondary snapshot to
572  * avoid this.
573  */
574  if (IsolationUsesXactSnapshot() && rel->rd_index->indcheckxmin &&
576  snapshot->xmin))
577  ereport(ERROR,
579  errmsg("index \"%s\" cannot be verified using transaction snapshot",
580  RelationGetRelationName(rel))));
581  }
582  }
583 
584  /*
585  * We need a snapshot to check the uniqueness of the index. For better
586  * performance take it once per index check. If snapshot already taken
587  * reuse it.
588  */
589  if (state->checkunique)
590  {
591  state->indexinfo = BuildIndexInfo(state->rel);
592  if (state->indexinfo->ii_Unique)
593  {
594  if (snapshot != SnapshotAny)
595  state->snapshot = snapshot;
596  else
598  }
599  }
600 
601  Assert(!state->rootdescend || state->readonly);
602  if (state->rootdescend && !state->heapkeyspace)
603  ereport(ERROR,
604  (errcode(ERRCODE_FEATURE_NOT_SUPPORTED),
605  errmsg("cannot verify that tuples from index \"%s\" can each be found by an independent index search",
607  errhint("Only B-Tree version 4 indexes support rootdescend verification.")));
608 
609  /* Create context for page */
611  "amcheck context",
613  state->checkstrategy = GetAccessStrategy(BAS_BULKREAD);
614 
615  /* Get true root block from meta-page */
617  metad = BTPageGetMeta(metapage);
618 
619  /*
620  * Certain deletion patterns can result in "skinny" B-Tree indexes, where
621  * the fast root and true root differ.
622  *
623  * Start from the true root, not the fast root, unlike conventional index
624  * scans. This approach is more thorough, and removes the risk of
625  * following a stale fast root from the meta page.
626  */
627  if (metad->btm_fastroot != metad->btm_root)
628  ereport(DEBUG1,
629  (errcode(ERRCODE_NO_DATA),
630  errmsg_internal("harmless fast root mismatch in index \"%s\"",
632  errdetail_internal("Fast root block %u (level %u) differs from true root block %u (level %u).",
633  metad->btm_fastroot, metad->btm_fastlevel,
634  metad->btm_root, metad->btm_level)));
635 
636  /*
637  * Starting at the root, verify every level. Move left to right, top to
638  * bottom. Note that there may be no pages other than the meta page (meta
639  * page can indicate that root is P_NONE when the index is totally empty).
640  */
641  previouslevel = InvalidBtreeLevel;
642  current.level = metad->btm_level;
643  current.leftmost = metad->btm_root;
644  current.istruerootlevel = true;
645  while (current.leftmost != P_NONE)
646  {
647  /*
648  * Verify this level, and get left most page for next level down, if
649  * not at leaf level
650  */
651  current = bt_check_level_from_leftmost(state, current);
652 
653  if (current.leftmost == InvalidBlockNumber)
654  ereport(ERROR,
655  (errcode(ERRCODE_INDEX_CORRUPTED),
656  errmsg("index \"%s\" has no valid pages on level below %u or first level",
657  RelationGetRelationName(rel), previouslevel)));
658 
659  previouslevel = current.level;
660  }
661 
662  /*
663  * * Check whether heap contains unindexed/malformed tuples *
664  */
665  if (state->heapallindexed)
666  {
667  IndexInfo *indexinfo = BuildIndexInfo(state->rel);
668  TableScanDesc scan;
669 
670  /*
671  * Create our own scan for table_index_build_scan(), rather than
672  * getting it to do so for us. This is required so that we can
673  * actually use the MVCC snapshot registered earlier in !readonly
674  * case.
675  *
676  * Note that table_index_build_scan() calls heap_endscan() for us.
677  */
678  scan = table_beginscan_strat(state->heaprel, /* relation */
679  snapshot, /* snapshot */
680  0, /* number of keys */
681  NULL, /* scan key */
682  true, /* buffer access strategy OK */
683  true); /* syncscan OK? */
684 
685  /*
686  * Scan will behave as the first scan of a CREATE INDEX CONCURRENTLY
687  * behaves in !readonly case.
688  *
689  * It's okay that we don't actually use the same lock strength for the
690  * heap relation as any other ii_Concurrent caller would in !readonly
691  * case. We have no reason to care about a concurrent VACUUM
692  * operation, since there isn't going to be a second scan of the heap
693  * that needs to be sure that there was no concurrent recycling of
694  * TIDs.
695  */
696  indexinfo->ii_Concurrent = !state->readonly;
697 
698  /*
699  * Don't wait for uncommitted tuple xact commit/abort when index is a
700  * unique index on a catalog (or an index used by an exclusion
701  * constraint). This could otherwise happen in the readonly case.
702  */
703  indexinfo->ii_Unique = false;
704  indexinfo->ii_ExclusionOps = NULL;
705  indexinfo->ii_ExclusionProcs = NULL;
706  indexinfo->ii_ExclusionStrats = NULL;
707 
708  elog(DEBUG1, "verifying that tuples from index \"%s\" are present in \"%s\"",
710  RelationGetRelationName(state->heaprel));
711 
712  table_index_build_scan(state->heaprel, state->rel, indexinfo, true, false,
713  bt_tuple_present_callback, (void *) state, scan);
714 
715  ereport(DEBUG1,
716  (errmsg_internal("finished verifying presence of " INT64_FORMAT " tuples from table \"%s\" with bitset %.2f%% set",
717  state->heaptuplespresent, RelationGetRelationName(heaprel),
718  100.0 * bloom_prop_bits_set(state->filter))));
719 
720  if (snapshot != SnapshotAny)
721  UnregisterSnapshot(snapshot);
722 
723  bloom_free(state->filter);
724  }
725 
726  /* Be tidy: */
727  if (snapshot == SnapshotAny && state->snapshot != InvalidSnapshot)
728  UnregisterSnapshot(state->snapshot);
729  MemoryContextDelete(state->targetcontext);
730 }
731 
732 /*
733  * Given a left-most block at some level, move right, verifying each page
734  * individually (with more verification across pages for "readonly"
735  * callers). Caller should pass the true root page as the leftmost initially,
736  * working their way down by passing what is returned for the last call here
737  * until level 0 (leaf page level) was reached.
738  *
739  * Returns state for next call, if any. This includes left-most block number
740  * one level lower that should be passed on next level/call, which is set to
741  * P_NONE on last call here (when leaf level is verified). Level numbers
742  * follow the nbtree convention: higher levels have higher numbers, because new
743  * levels are added only due to a root page split. Note that prior to the
744  * first root page split, the root is also a leaf page, so there is always a
745  * level 0 (leaf level), and it's always the last level processed.
746  *
747  * Note on memory management: State's per-page context is reset here, between
748  * each call to bt_target_page_check().
749  */
750 static BtreeLevel
752 {
753  /* State to establish early, concerning entire level */
754  BTPageOpaque opaque;
755  MemoryContext oldcontext;
756  BtreeLevel nextleveldown;
757 
758  /* Variables for iterating across level using right links */
759  BlockNumber leftcurrent = P_NONE;
760  BlockNumber current = level.leftmost;
761 
762  /* Initialize return state */
763  nextleveldown.leftmost = InvalidBlockNumber;
764  nextleveldown.level = InvalidBtreeLevel;
765  nextleveldown.istruerootlevel = false;
766 
767  /* Use page-level context for duration of this call */
768  oldcontext = MemoryContextSwitchTo(state->targetcontext);
769 
770  elog(DEBUG1, "verifying level %u%s", level.level,
771  level.istruerootlevel ?
772  " (true root level)" : level.level == 0 ? " (leaf level)" : "");
773 
774  state->prevrightlink = InvalidBlockNumber;
775  state->previncompletesplit = false;
776 
777  do
778  {
779  /* Don't rely on CHECK_FOR_INTERRUPTS() calls at lower level */
781 
782  /* Initialize state for this iteration */
783  state->targetblock = current;
784  state->target = palloc_btree_page(state, state->targetblock);
785  state->targetlsn = PageGetLSN(state->target);
786 
787  opaque = BTPageGetOpaque(state->target);
788 
789  if (P_IGNORE(opaque))
790  {
791  /*
792  * Since there cannot be a concurrent VACUUM operation in readonly
793  * mode, and since a page has no links within other pages
794  * (siblings and parent) once it is marked fully deleted, it
795  * should be impossible to land on a fully deleted page in
796  * readonly mode. See bt_child_check() for further details.
797  *
798  * The bt_child_check() P_ISDELETED() check is repeated here so
799  * that pages that are only reachable through sibling links get
800  * checked.
801  */
802  if (state->readonly && P_ISDELETED(opaque))
803  ereport(ERROR,
804  (errcode(ERRCODE_INDEX_CORRUPTED),
805  errmsg("downlink or sibling link points to deleted block in index \"%s\"",
807  errdetail_internal("Block=%u left block=%u left link from block=%u.",
808  current, leftcurrent, opaque->btpo_prev)));
809 
810  if (P_RIGHTMOST(opaque))
811  ereport(ERROR,
812  (errcode(ERRCODE_INDEX_CORRUPTED),
813  errmsg("block %u fell off the end of index \"%s\"",
814  current, RelationGetRelationName(state->rel))));
815  else
816  ereport(DEBUG1,
817  (errcode(ERRCODE_NO_DATA),
818  errmsg_internal("block %u of index \"%s\" concurrently deleted",
819  current, RelationGetRelationName(state->rel))));
820  goto nextpage;
821  }
822  else if (nextleveldown.leftmost == InvalidBlockNumber)
823  {
824  /*
825  * A concurrent page split could make the caller supplied leftmost
826  * block no longer contain the leftmost page, or no longer be the
827  * true root, but where that isn't possible due to heavyweight
828  * locking, check that the first valid page meets caller's
829  * expectations.
830  */
831  if (state->readonly)
832  {
833  if (!bt_leftmost_ignoring_half_dead(state, current, opaque))
834  ereport(ERROR,
835  (errcode(ERRCODE_INDEX_CORRUPTED),
836  errmsg("block %u is not leftmost in index \"%s\"",
837  current, RelationGetRelationName(state->rel))));
838 
839  if (level.istruerootlevel && !P_ISROOT(opaque))
840  ereport(ERROR,
841  (errcode(ERRCODE_INDEX_CORRUPTED),
842  errmsg("block %u is not true root in index \"%s\"",
843  current, RelationGetRelationName(state->rel))));
844  }
845 
846  /*
847  * Before beginning any non-trivial examination of level, prepare
848  * state for next bt_check_level_from_leftmost() invocation for
849  * the next level for the next level down (if any).
850  *
851  * There should be at least one non-ignorable page per level,
852  * unless this is the leaf level, which is assumed by caller to be
853  * final level.
854  */
855  if (!P_ISLEAF(opaque))
856  {
857  IndexTuple itup;
858  ItemId itemid;
859 
860  /* Internal page -- downlink gets leftmost on next level */
861  itemid = PageGetItemIdCareful(state, state->targetblock,
862  state->target,
863  P_FIRSTDATAKEY(opaque));
864  itup = (IndexTuple) PageGetItem(state->target, itemid);
865  nextleveldown.leftmost = BTreeTupleGetDownLink(itup);
866  nextleveldown.level = opaque->btpo_level - 1;
867  }
868  else
869  {
870  /*
871  * Leaf page -- final level caller must process.
872  *
873  * Note that this could also be the root page, if there has
874  * been no root page split yet.
875  */
876  nextleveldown.leftmost = P_NONE;
877  nextleveldown.level = InvalidBtreeLevel;
878  }
879 
880  /*
881  * Finished setting up state for this call/level. Control will
882  * never end up back here in any future loop iteration for this
883  * level.
884  */
885  }
886 
887  /*
888  * Sibling links should be in mutual agreement. There arises
889  * leftcurrent == P_NONE && btpo_prev != P_NONE when the left sibling
890  * of the parent's low-key downlink is half-dead. (A half-dead page
891  * has no downlink from its parent.) Under heavyweight locking, the
892  * last bt_leftmost_ignoring_half_dead() validated this btpo_prev.
893  * Without heavyweight locking, validation of the P_NONE case remains
894  * unimplemented.
895  */
896  if (opaque->btpo_prev != leftcurrent && leftcurrent != P_NONE)
897  bt_recheck_sibling_links(state, opaque->btpo_prev, leftcurrent);
898 
899  /* Check level */
900  if (level.level != opaque->btpo_level)
901  ereport(ERROR,
902  (errcode(ERRCODE_INDEX_CORRUPTED),
903  errmsg("leftmost down link for level points to block in index \"%s\" whose level is not one level down",
905  errdetail_internal("Block pointed to=%u expected level=%u level in pointed to block=%u.",
906  current, level.level, opaque->btpo_level)));
907 
908  /* Verify invariants for page */
910 
911 nextpage:
912 
913  /* Try to detect circular links */
914  if (current == leftcurrent || current == opaque->btpo_prev)
915  ereport(ERROR,
916  (errcode(ERRCODE_INDEX_CORRUPTED),
917  errmsg("circular link chain found in block %u of index \"%s\"",
918  current, RelationGetRelationName(state->rel))));
919 
920  leftcurrent = current;
921  current = opaque->btpo_next;
922 
923  if (state->lowkey)
924  {
925  Assert(state->readonly);
926  pfree(state->lowkey);
927  state->lowkey = NULL;
928  }
929 
930  /*
931  * Copy current target high key as the low key of right sibling.
932  * Allocate memory in upper level context, so it would be cleared
933  * after reset of target context.
934  *
935  * We only need the low key in corner cases of checking child high
936  * keys. We use high key only when incomplete split on the child level
937  * falls to the boundary of pages on the target level. See
938  * bt_child_highkey_check() for details. So, typically we won't end
939  * up doing anything with low key, but it's simpler for general case
940  * high key verification to always have it available.
941  *
942  * The correctness of managing low key in the case of concurrent
943  * splits wasn't investigated yet. Thankfully we only need low key
944  * for readonly verification and concurrent splits won't happen.
945  */
946  if (state->readonly && !P_RIGHTMOST(opaque))
947  {
948  IndexTuple itup;
949  ItemId itemid;
950 
951  itemid = PageGetItemIdCareful(state, state->targetblock,
952  state->target, P_HIKEY);
953  itup = (IndexTuple) PageGetItem(state->target, itemid);
954 
955  state->lowkey = MemoryContextAlloc(oldcontext, IndexTupleSize(itup));
956  memcpy(state->lowkey, itup, IndexTupleSize(itup));
957  }
958 
959  /* Free page and associated memory for this iteration */
960  MemoryContextReset(state->targetcontext);
961  }
962  while (current != P_NONE);
963 
964  if (state->lowkey)
965  {
966  Assert(state->readonly);
967  pfree(state->lowkey);
968  state->lowkey = NULL;
969  }
970 
971  /* Don't change context for caller */
972  MemoryContextSwitchTo(oldcontext);
973 
974  return nextleveldown;
975 }
976 
977 /* Check visibility of the table entry referenced by nbtree index */
978 static bool
980 {
981  bool tid_visible;
982 
983  TupleTableSlot *slot = table_slot_create(state->heaprel, NULL);
984 
985  tid_visible = table_tuple_fetch_row_version(state->heaprel,
986  tid, state->snapshot, slot);
987  if (slot != NULL)
989 
990  return tid_visible;
991 }
992 
993 /*
994  * Prepare an error message for unique constrain violation in
995  * a btree index and report ERROR.
996  */
997 static void
999  ItemPointer tid, BlockNumber block, OffsetNumber offset,
1000  int posting,
1001  ItemPointer nexttid, BlockNumber nblock, OffsetNumber noffset,
1002  int nposting)
1003 {
1004  char *htid,
1005  *nhtid,
1006  *itid,
1007  *nitid = "",
1008  *pposting = "",
1009  *pnposting = "";
1010 
1011  htid = psprintf("tid=(%u,%u)",
1014  nhtid = psprintf("tid=(%u,%u)",
1017  itid = psprintf("tid=(%u,%u)", block, offset);
1018 
1019  if (nblock != block || noffset != offset)
1020  nitid = psprintf(" tid=(%u,%u)", nblock, noffset);
1021 
1022  if (posting >= 0)
1023  pposting = psprintf(" posting %u", posting);
1024 
1025  if (nposting >= 0)
1026  pnposting = psprintf(" posting %u", nposting);
1027 
1028  ereport(ERROR,
1029  (errcode(ERRCODE_INDEX_CORRUPTED),
1030  errmsg("index uniqueness is violated for index \"%s\"",
1032  errdetail("Index %s%s and%s%s (point to heap %s and %s) page lsn=%X/%X.",
1033  itid, pposting, nitid, pnposting, htid, nhtid,
1034  LSN_FORMAT_ARGS(state->targetlsn))));
1035 }
1036 
1037 /* Check if current nbtree leaf entry complies with UNIQUE constraint */
1038 static void
1040  BlockNumber targetblock, OffsetNumber offset, int *lVis_i,
1041  ItemPointer *lVis_tid, OffsetNumber *lVis_offset,
1042  BlockNumber *lVis_block)
1043 {
1044  ItemPointer tid;
1045  bool has_visible_entry = false;
1046 
1047  Assert(targetblock != P_NONE);
1048 
1049  /*
1050  * Current tuple has posting list. Report duplicate if TID of any posting
1051  * list entry is visible and lVis_tid is valid.
1052  */
1053  if (BTreeTupleIsPosting(itup))
1054  {
1055  for (int i = 0; i < BTreeTupleGetNPosting(itup); i++)
1056  {
1057  tid = BTreeTupleGetPostingN(itup, i);
1058  if (heap_entry_is_visible(state, tid))
1059  {
1060  has_visible_entry = true;
1061  if (ItemPointerIsValid(*lVis_tid))
1062  {
1064  *lVis_tid, *lVis_block,
1065  *lVis_offset, *lVis_i,
1066  tid, targetblock,
1067  offset, i);
1068  }
1069 
1070  /*
1071  * Prevent double reporting unique constraint violation
1072  * between the posting list entries of the first tuple on the
1073  * page after cross-page check.
1074  */
1075  if (*lVis_block != targetblock && ItemPointerIsValid(*lVis_tid))
1076  return;
1077 
1078  *lVis_i = i;
1079  *lVis_tid = tid;
1080  *lVis_offset = offset;
1081  *lVis_block = targetblock;
1082  }
1083  }
1084  }
1085 
1086  /*
1087  * Current tuple has no posting list. If TID is visible save info about it
1088  * for the next comparisons in the loop in bt_page_check(). Report
1089  * duplicate if lVis_tid is already valid.
1090  */
1091  else
1092  {
1093  tid = BTreeTupleGetHeapTID(itup);
1094  if (heap_entry_is_visible(state, tid))
1095  {
1096  has_visible_entry = true;
1097  if (ItemPointerIsValid(*lVis_tid))
1098  {
1100  *lVis_tid, *lVis_block,
1101  *lVis_offset, *lVis_i,
1102  tid, targetblock,
1103  offset, -1);
1104  }
1105  *lVis_i = -1;
1106  *lVis_tid = tid;
1107  *lVis_offset = offset;
1108  *lVis_block = targetblock;
1109  }
1110  }
1111 
1112  if (!has_visible_entry && *lVis_block != InvalidBlockNumber &&
1113  *lVis_block != targetblock)
1114  {
1115  char *posting = "";
1116 
1117  if (*lVis_i >= 0)
1118  posting = psprintf(" posting %u", *lVis_i);
1119  ereport(DEBUG1,
1120  (errcode(ERRCODE_NO_DATA),
1121  errmsg("index uniqueness can not be checked for index tid=(%u,%u) in index \"%s\"",
1122  targetblock, offset,
1124  errdetail("It doesn't have visible heap tids and key is equal to the tid=(%u,%u)%s (points to heap tid=(%u,%u)).",
1125  *lVis_block, *lVis_offset, posting,
1128  errhint("VACUUM the table and repeat the check.")));
1129  }
1130 }
1131 
1132 /*
1133  * Like P_LEFTMOST(start_opaque), but accept an arbitrarily-long chain of
1134  * half-dead, sibling-linked pages to the left. If a half-dead page appears
1135  * under state->readonly, the database exited recovery between the first-stage
1136  * and second-stage WAL records of a deletion.
1137  */
1138 static bool
1140  BlockNumber start,
1141  BTPageOpaque start_opaque)
1142 {
1143  BlockNumber reached = start_opaque->btpo_prev,
1144  reached_from = start;
1145  bool all_half_dead = true;
1146 
1147  /*
1148  * To handle the !readonly case, we'd need to accept BTP_DELETED pages and
1149  * potentially observe nbtree/README "Page deletion and backwards scans".
1150  */
1151  Assert(state->readonly);
1152 
1153  while (reached != P_NONE && all_half_dead)
1154  {
1155  Page page = palloc_btree_page(state, reached);
1156  BTPageOpaque reached_opaque = BTPageGetOpaque(page);
1157 
1159 
1160  /*
1161  * Try to detect btpo_prev circular links. _bt_unlink_halfdead_page()
1162  * writes that side-links will continue to point to the siblings.
1163  * Check btpo_next for that property.
1164  */
1165  all_half_dead = P_ISHALFDEAD(reached_opaque) &&
1166  reached != start &&
1167  reached != reached_from &&
1168  reached_opaque->btpo_next == reached_from;
1169  if (all_half_dead)
1170  {
1171  XLogRecPtr pagelsn = PageGetLSN(page);
1172 
1173  /* pagelsn should point to an XLOG_BTREE_MARK_PAGE_HALFDEAD */
1174  ereport(DEBUG1,
1175  (errcode(ERRCODE_NO_DATA),
1176  errmsg_internal("harmless interrupted page deletion detected in index \"%s\"",
1178  errdetail_internal("Block=%u right block=%u page lsn=%X/%X.",
1179  reached, reached_from,
1180  LSN_FORMAT_ARGS(pagelsn))));
1181 
1182  reached_from = reached;
1183  reached = reached_opaque->btpo_prev;
1184  }
1185 
1186  pfree(page);
1187  }
1188 
1189  return all_half_dead;
1190 }
1191 
1192 /*
1193  * Raise an error when target page's left link does not point back to the
1194  * previous target page, called leftcurrent here. The leftcurrent page's
1195  * right link was followed to get to the current target page, and we expect
1196  * mutual agreement among leftcurrent and the current target page. Make sure
1197  * that this condition has definitely been violated in the !readonly case,
1198  * where concurrent page splits are something that we need to deal with.
1199  *
1200  * Cross-page inconsistencies involving pages that don't agree about being
1201  * siblings are known to be a particularly good indicator of corruption
1202  * involving partial writes/lost updates. The bt_right_page_check_scankey
1203  * check also provides a way of detecting cross-page inconsistencies for
1204  * !readonly callers, but it can only detect sibling pages that have an
1205  * out-of-order keyspace, which can't catch many of the problems that we
1206  * expect to catch here.
1207  *
1208  * The classic example of the kind of inconsistency that we can only catch
1209  * with this check (when in !readonly mode) involves three sibling pages that
1210  * were affected by a faulty page split at some point in the past. The
1211  * effects of the split are reflected in the original page and its new right
1212  * sibling page, with a lack of any accompanying changes for the _original_
1213  * right sibling page. The original right sibling page's left link fails to
1214  * point to the new right sibling page (its left link still points to the
1215  * original page), even though the first phase of a page split is supposed to
1216  * work as a single atomic action. This subtle inconsistency will probably
1217  * only break backwards scans in practice.
1218  *
1219  * Note that this is the only place where amcheck will "couple" buffer locks
1220  * (and only for !readonly callers). In general we prefer to avoid more
1221  * thorough cross-page checks in !readonly mode, but it seems worth the
1222  * complexity here. Also, the performance overhead of performing lock
1223  * coupling here is negligible in practice. Control only reaches here with a
1224  * non-corrupt index when there is a concurrent page split at the instant
1225  * caller crossed over to target page from leftcurrent page.
1226  */
1227 static void
1229  BlockNumber btpo_prev_from_target,
1230  BlockNumber leftcurrent)
1231 {
1232  /* passing metapage to BTPageGetOpaque() would give irrelevant findings */
1233  Assert(leftcurrent != P_NONE);
1234 
1235  if (!state->readonly)
1236  {
1237  Buffer lbuf;
1238  Buffer newtargetbuf;
1239  Page page;
1240  BTPageOpaque opaque;
1241  BlockNumber newtargetblock;
1242 
1243  /* Couple locks in the usual order for nbtree: Left to right */
1244  lbuf = ReadBufferExtended(state->rel, MAIN_FORKNUM, leftcurrent,
1245  RBM_NORMAL, state->checkstrategy);
1246  LockBuffer(lbuf, BT_READ);
1247  _bt_checkpage(state->rel, lbuf);
1248  page = BufferGetPage(lbuf);
1249  opaque = BTPageGetOpaque(page);
1250  if (P_ISDELETED(opaque))
1251  {
1252  /*
1253  * Cannot reason about concurrently deleted page -- the left link
1254  * in the page to the right is expected to point to some other
1255  * page to the left (not leftcurrent page).
1256  *
1257  * Note that we deliberately don't give up with a half-dead page.
1258  */
1259  UnlockReleaseBuffer(lbuf);
1260  return;
1261  }
1262 
1263  newtargetblock = opaque->btpo_next;
1264  /* Avoid self-deadlock when newtargetblock == leftcurrent */
1265  if (newtargetblock != leftcurrent)
1266  {
1267  newtargetbuf = ReadBufferExtended(state->rel, MAIN_FORKNUM,
1268  newtargetblock, RBM_NORMAL,
1269  state->checkstrategy);
1270  LockBuffer(newtargetbuf, BT_READ);
1271  _bt_checkpage(state->rel, newtargetbuf);
1272  page = BufferGetPage(newtargetbuf);
1273  opaque = BTPageGetOpaque(page);
1274  /* btpo_prev_from_target may have changed; update it */
1275  btpo_prev_from_target = opaque->btpo_prev;
1276  }
1277  else
1278  {
1279  /*
1280  * leftcurrent right sibling points back to leftcurrent block.
1281  * Index is corrupt. Easiest way to handle this is to pretend
1282  * that we actually read from a distinct page that has an invalid
1283  * block number in its btpo_prev.
1284  */
1285  newtargetbuf = InvalidBuffer;
1286  btpo_prev_from_target = InvalidBlockNumber;
1287  }
1288 
1289  /*
1290  * No need to check P_ISDELETED here, since new target block cannot be
1291  * marked deleted as long as we hold a lock on lbuf
1292  */
1293  if (BufferIsValid(newtargetbuf))
1294  UnlockReleaseBuffer(newtargetbuf);
1295  UnlockReleaseBuffer(lbuf);
1296 
1297  if (btpo_prev_from_target == leftcurrent)
1298  {
1299  /* Report split in left sibling, not target (or new target) */
1300  ereport(DEBUG1,
1301  (errcode(ERRCODE_INTERNAL_ERROR),
1302  errmsg_internal("harmless concurrent page split detected in index \"%s\"",
1304  errdetail_internal("Block=%u new right sibling=%u original right sibling=%u.",
1305  leftcurrent, newtargetblock,
1306  state->targetblock)));
1307  return;
1308  }
1309 
1310  /*
1311  * Index is corrupt. Make sure that we report correct target page.
1312  *
1313  * This could have changed in cases where there was a concurrent page
1314  * split, as well as index corruption (at least in theory). Note that
1315  * btpo_prev_from_target was already updated above.
1316  */
1317  state->targetblock = newtargetblock;
1318  }
1319 
1320  ereport(ERROR,
1321  (errcode(ERRCODE_INDEX_CORRUPTED),
1322  errmsg("left link/right link pair in index \"%s\" not in agreement",
1324  errdetail_internal("Block=%u left block=%u left link from block=%u.",
1325  state->targetblock, leftcurrent,
1326  btpo_prev_from_target)));
1327 }
1328 
1329 /*
1330  * Function performs the following checks on target page, or pages ancillary to
1331  * target page:
1332  *
1333  * - That every "real" data item is less than or equal to the high key, which
1334  * is an upper bound on the items on the page. Data items should be
1335  * strictly less than the high key when the page is an internal page.
1336  *
1337  * - That within the page, every data item is strictly less than the item
1338  * immediately to its right, if any (i.e., that the items are in order
1339  * within the page, so that the binary searches performed by index scans are
1340  * sane).
1341  *
1342  * - That the last data item stored on the page is strictly less than the
1343  * first data item on the page to the right (when such a first item is
1344  * available).
1345  *
1346  * - Various checks on the structure of tuples themselves. For example, check
1347  * that non-pivot tuples have no truncated attributes.
1348  *
1349  * - For index with unique constraint make sure that only one of table entries
1350  * for equal keys is visible.
1351  *
1352  * Furthermore, when state passed shows ShareLock held, function also checks:
1353  *
1354  * - That all child pages respect strict lower bound from parent's pivot
1355  * tuple.
1356  *
1357  * - That downlink to block was encountered in parent where that's expected.
1358  *
1359  * - That high keys of child pages matches corresponding pivot keys in parent.
1360  *
1361  * This is also where heapallindexed callers use their Bloom filter to
1362  * fingerprint IndexTuples for later table_index_build_scan() verification.
1363  *
1364  * Note: Memory allocated in this routine is expected to be released by caller
1365  * resetting state->targetcontext.
1366  */
1367 static void
1369 {
1370  OffsetNumber offset;
1371  OffsetNumber max;
1372  BTPageOpaque topaque;
1373 
1374  /* last visible entry info for checking indexes with unique constraint */
1375  int lVis_i = -1; /* the position of last visible item for
1376  * posting tuple. for non-posting tuple (-1) */
1377  ItemPointer lVis_tid = NULL;
1378  BlockNumber lVis_block = InvalidBlockNumber;
1379  OffsetNumber lVis_offset = InvalidOffsetNumber;
1380 
1381  topaque = BTPageGetOpaque(state->target);
1382  max = PageGetMaxOffsetNumber(state->target);
1383 
1384  elog(DEBUG2, "verifying %u items on %s block %u", max,
1385  P_ISLEAF(topaque) ? "leaf" : "internal", state->targetblock);
1386 
1387  /*
1388  * Check the number of attributes in high key. Note, rightmost page
1389  * doesn't contain a high key, so nothing to check
1390  */
1391  if (!P_RIGHTMOST(topaque))
1392  {
1393  ItemId itemid;
1394  IndexTuple itup;
1395 
1396  /* Verify line pointer before checking tuple */
1397  itemid = PageGetItemIdCareful(state, state->targetblock,
1398  state->target, P_HIKEY);
1399  if (!_bt_check_natts(state->rel, state->heapkeyspace, state->target,
1400  P_HIKEY))
1401  {
1402  itup = (IndexTuple) PageGetItem(state->target, itemid);
1403  ereport(ERROR,
1404  (errcode(ERRCODE_INDEX_CORRUPTED),
1405  errmsg("wrong number of high key index tuple attributes in index \"%s\"",
1407  errdetail_internal("Index block=%u natts=%u block type=%s page lsn=%X/%X.",
1408  state->targetblock,
1409  BTreeTupleGetNAtts(itup, state->rel),
1410  P_ISLEAF(topaque) ? "heap" : "index",
1411  LSN_FORMAT_ARGS(state->targetlsn))));
1412  }
1413  }
1414 
1415  /*
1416  * Loop over page items, starting from first non-highkey item, not high
1417  * key (if any). Most tests are not performed for the "negative infinity"
1418  * real item (if any).
1419  */
1420  for (offset = P_FIRSTDATAKEY(topaque);
1421  offset <= max;
1422  offset = OffsetNumberNext(offset))
1423  {
1424  ItemId itemid;
1425  IndexTuple itup;
1426  size_t tupsize;
1427  BTScanInsert skey;
1428  bool lowersizelimit;
1429  ItemPointer scantid;
1430 
1432 
1433  itemid = PageGetItemIdCareful(state, state->targetblock,
1434  state->target, offset);
1435  itup = (IndexTuple) PageGetItem(state->target, itemid);
1436  tupsize = IndexTupleSize(itup);
1437 
1438  /*
1439  * lp_len should match the IndexTuple reported length exactly, since
1440  * lp_len is completely redundant in indexes, and both sources of
1441  * tuple length are MAXALIGN()'d. nbtree does not use lp_len all that
1442  * frequently, and is surprisingly tolerant of corrupt lp_len fields.
1443  */
1444  if (tupsize != ItemIdGetLength(itemid))
1445  ereport(ERROR,
1446  (errcode(ERRCODE_INDEX_CORRUPTED),
1447  errmsg("index tuple size does not equal lp_len in index \"%s\"",
1449  errdetail_internal("Index tid=(%u,%u) tuple size=%zu lp_len=%u page lsn=%X/%X.",
1450  state->targetblock, offset,
1451  tupsize, ItemIdGetLength(itemid),
1452  LSN_FORMAT_ARGS(state->targetlsn)),
1453  errhint("This could be a torn page problem.")));
1454 
1455  /* Check the number of index tuple attributes */
1456  if (!_bt_check_natts(state->rel, state->heapkeyspace, state->target,
1457  offset))
1458  {
1459  ItemPointer tid;
1460  char *itid,
1461  *htid;
1462 
1463  itid = psprintf("(%u,%u)", state->targetblock, offset);
1464  tid = BTreeTupleGetPointsToTID(itup);
1465  htid = psprintf("(%u,%u)",
1468 
1469  ereport(ERROR,
1470  (errcode(ERRCODE_INDEX_CORRUPTED),
1471  errmsg("wrong number of index tuple attributes in index \"%s\"",
1473  errdetail_internal("Index tid=%s natts=%u points to %s tid=%s page lsn=%X/%X.",
1474  itid,
1475  BTreeTupleGetNAtts(itup, state->rel),
1476  P_ISLEAF(topaque) ? "heap" : "index",
1477  htid,
1478  LSN_FORMAT_ARGS(state->targetlsn))));
1479  }
1480 
1481  /*
1482  * Don't try to generate scankey using "negative infinity" item on
1483  * internal pages. They are always truncated to zero attributes.
1484  */
1485  if (offset_is_negative_infinity(topaque, offset))
1486  {
1487  /*
1488  * We don't call bt_child_check() for "negative infinity" items.
1489  * But if we're performing downlink connectivity check, we do it
1490  * for every item including "negative infinity" one.
1491  */
1492  if (!P_ISLEAF(topaque) && state->readonly)
1493  {
1495  offset,
1496  NULL,
1497  topaque->btpo_level);
1498  }
1499  continue;
1500  }
1501 
1502  /*
1503  * Readonly callers may optionally verify that non-pivot tuples can
1504  * each be found by an independent search that starts from the root.
1505  * Note that we deliberately don't do individual searches for each
1506  * TID, since the posting list itself is validated by other checks.
1507  */
1508  if (state->rootdescend && P_ISLEAF(topaque) &&
1509  !bt_rootdescend(state, itup))
1510  {
1512  char *itid,
1513  *htid;
1514 
1515  itid = psprintf("(%u,%u)", state->targetblock, offset);
1516  htid = psprintf("(%u,%u)", ItemPointerGetBlockNumber(tid),
1518 
1519  ereport(ERROR,
1520  (errcode(ERRCODE_INDEX_CORRUPTED),
1521  errmsg("could not find tuple using search from root page in index \"%s\"",
1523  errdetail_internal("Index tid=%s points to heap tid=%s page lsn=%X/%X.",
1524  itid, htid,
1525  LSN_FORMAT_ARGS(state->targetlsn))));
1526  }
1527 
1528  /*
1529  * If tuple is a posting list tuple, make sure posting list TIDs are
1530  * in order
1531  */
1532  if (BTreeTupleIsPosting(itup))
1533  {
1534  ItemPointerData last;
1535  ItemPointer current;
1536 
1537  ItemPointerCopy(BTreeTupleGetHeapTID(itup), &last);
1538 
1539  for (int i = 1; i < BTreeTupleGetNPosting(itup); i++)
1540  {
1541 
1542  current = BTreeTupleGetPostingN(itup, i);
1543 
1544  if (ItemPointerCompare(current, &last) <= 0)
1545  {
1546  char *itid = psprintf("(%u,%u)", state->targetblock, offset);
1547 
1548  ereport(ERROR,
1549  (errcode(ERRCODE_INDEX_CORRUPTED),
1550  errmsg_internal("posting list contains misplaced TID in index \"%s\"",
1552  errdetail_internal("Index tid=%s posting list offset=%d page lsn=%X/%X.",
1553  itid, i,
1554  LSN_FORMAT_ARGS(state->targetlsn))));
1555  }
1556 
1557  ItemPointerCopy(current, &last);
1558  }
1559  }
1560 
1561  /* Build insertion scankey for current page offset */
1562  skey = bt_mkscankey_pivotsearch(state->rel, itup);
1563 
1564  /*
1565  * Make sure tuple size does not exceed the relevant BTREE_VERSION
1566  * specific limit.
1567  *
1568  * BTREE_VERSION 4 (which introduced heapkeyspace rules) requisitioned
1569  * a small amount of space from BTMaxItemSize() in order to ensure
1570  * that suffix truncation always has enough space to add an explicit
1571  * heap TID back to a tuple -- we pessimistically assume that every
1572  * newly inserted tuple will eventually need to have a heap TID
1573  * appended during a future leaf page split, when the tuple becomes
1574  * the basis of the new high key (pivot tuple) for the leaf page.
1575  *
1576  * Since the reclaimed space is reserved for that purpose, we must not
1577  * enforce the slightly lower limit when the extra space has been used
1578  * as intended. In other words, there is only a cross-version
1579  * difference in the limit on tuple size within leaf pages.
1580  *
1581  * Still, we're particular about the details within BTREE_VERSION 4
1582  * internal pages. Pivot tuples may only use the extra space for its
1583  * designated purpose. Enforce the lower limit for pivot tuples when
1584  * an explicit heap TID isn't actually present. (In all other cases
1585  * suffix truncation is guaranteed to generate a pivot tuple that's no
1586  * larger than the firstright tuple provided to it by its caller.)
1587  */
1588  lowersizelimit = skey->heapkeyspace &&
1589  (P_ISLEAF(topaque) || BTreeTupleGetHeapTID(itup) == NULL);
1590  if (tupsize > (lowersizelimit ? BTMaxItemSize(state->target) :
1591  BTMaxItemSizeNoHeapTid(state->target)))
1592  {
1594  char *itid,
1595  *htid;
1596 
1597  itid = psprintf("(%u,%u)", state->targetblock, offset);
1598  htid = psprintf("(%u,%u)",
1601 
1602  ereport(ERROR,
1603  (errcode(ERRCODE_INDEX_CORRUPTED),
1604  errmsg("index row size %zu exceeds maximum for index \"%s\"",
1605  tupsize, RelationGetRelationName(state->rel)),
1606  errdetail_internal("Index tid=%s points to %s tid=%s page lsn=%X/%X.",
1607  itid,
1608  P_ISLEAF(topaque) ? "heap" : "index",
1609  htid,
1610  LSN_FORMAT_ARGS(state->targetlsn))));
1611  }
1612 
1613  /* Fingerprint leaf page tuples (those that point to the heap) */
1614  if (state->heapallindexed && P_ISLEAF(topaque) && !ItemIdIsDead(itemid))
1615  {
1616  IndexTuple norm;
1617 
1618  if (BTreeTupleIsPosting(itup))
1619  {
1620  /* Fingerprint all elements as distinct "plain" tuples */
1621  for (int i = 0; i < BTreeTupleGetNPosting(itup); i++)
1622  {
1623  IndexTuple logtuple;
1624 
1625  logtuple = bt_posting_plain_tuple(itup, i);
1626  norm = bt_normalize_tuple(state, logtuple);
1627  bloom_add_element(state->filter, (unsigned char *) norm,
1628  IndexTupleSize(norm));
1629  /* Be tidy */
1630  if (norm != logtuple)
1631  pfree(norm);
1632  pfree(logtuple);
1633  }
1634  }
1635  else
1636  {
1637  norm = bt_normalize_tuple(state, itup);
1638  bloom_add_element(state->filter, (unsigned char *) norm,
1639  IndexTupleSize(norm));
1640  /* Be tidy */
1641  if (norm != itup)
1642  pfree(norm);
1643  }
1644  }
1645 
1646  /*
1647  * * High key check *
1648  *
1649  * If there is a high key (if this is not the rightmost page on its
1650  * entire level), check that high key actually is upper bound on all
1651  * page items. If this is a posting list tuple, we'll need to set
1652  * scantid to be highest TID in posting list.
1653  *
1654  * We prefer to check all items against high key rather than checking
1655  * just the last and trusting that the operator class obeys the
1656  * transitive law (which implies that all previous items also
1657  * respected the high key invariant if they pass the item order
1658  * check).
1659  *
1660  * Ideally, we'd compare every item in the index against every other
1661  * item in the index, and not trust opclass obedience of the
1662  * transitive law to bridge the gap between children and their
1663  * grandparents (as well as great-grandparents, and so on). We don't
1664  * go to those lengths because that would be prohibitively expensive,
1665  * and probably not markedly more effective in practice.
1666  *
1667  * On the leaf level, we check that the key is <= the highkey.
1668  * However, on non-leaf levels we check that the key is < the highkey,
1669  * because the high key is "just another separator" rather than a copy
1670  * of some existing key item; we expect it to be unique among all keys
1671  * on the same level. (Suffix truncation will sometimes produce a
1672  * leaf highkey that is an untruncated copy of the lastleft item, but
1673  * never any other item, which necessitates weakening the leaf level
1674  * check to <=.)
1675  *
1676  * Full explanation for why a highkey is never truly a copy of another
1677  * item from the same level on internal levels:
1678  *
1679  * While the new left page's high key is copied from the first offset
1680  * on the right page during an internal page split, that's not the
1681  * full story. In effect, internal pages are split in the middle of
1682  * the firstright tuple, not between the would-be lastleft and
1683  * firstright tuples: the firstright key ends up on the left side as
1684  * left's new highkey, and the firstright downlink ends up on the
1685  * right side as right's new "negative infinity" item. The negative
1686  * infinity tuple is truncated to zero attributes, so we're only left
1687  * with the downlink. In other words, the copying is just an
1688  * implementation detail of splitting in the middle of a (pivot)
1689  * tuple. (See also: "Notes About Data Representation" in the nbtree
1690  * README.)
1691  */
1692  scantid = skey->scantid;
1693  if (state->heapkeyspace && BTreeTupleIsPosting(itup))
1694  skey->scantid = BTreeTupleGetMaxHeapTID(itup);
1695 
1696  if (!P_RIGHTMOST(topaque) &&
1697  !(P_ISLEAF(topaque) ? invariant_leq_offset(state, skey, P_HIKEY) :
1698  invariant_l_offset(state, skey, P_HIKEY)))
1699  {
1701  char *itid,
1702  *htid;
1703 
1704  itid = psprintf("(%u,%u)", state->targetblock, offset);
1705  htid = psprintf("(%u,%u)",
1708 
1709  ereport(ERROR,
1710  (errcode(ERRCODE_INDEX_CORRUPTED),
1711  errmsg("high key invariant violated for index \"%s\"",
1713  errdetail_internal("Index tid=%s points to %s tid=%s page lsn=%X/%X.",
1714  itid,
1715  P_ISLEAF(topaque) ? "heap" : "index",
1716  htid,
1717  LSN_FORMAT_ARGS(state->targetlsn))));
1718  }
1719  /* Reset, in case scantid was set to (itup) posting tuple's max TID */
1720  skey->scantid = scantid;
1721 
1722  /*
1723  * * Item order check *
1724  *
1725  * Check that items are stored on page in logical order, by checking
1726  * current item is strictly less than next item (if any).
1727  */
1728  if (OffsetNumberNext(offset) <= max &&
1729  !invariant_l_offset(state, skey, OffsetNumberNext(offset)))
1730  {
1731  ItemPointer tid;
1732  char *itid,
1733  *htid,
1734  *nitid,
1735  *nhtid;
1736 
1737  itid = psprintf("(%u,%u)", state->targetblock, offset);
1738  tid = BTreeTupleGetPointsToTID(itup);
1739  htid = psprintf("(%u,%u)",
1742  nitid = psprintf("(%u,%u)", state->targetblock,
1743  OffsetNumberNext(offset));
1744 
1745  /* Reuse itup to get pointed-to heap location of second item */
1746  itemid = PageGetItemIdCareful(state, state->targetblock,
1747  state->target,
1748  OffsetNumberNext(offset));
1749  itup = (IndexTuple) PageGetItem(state->target, itemid);
1750  tid = BTreeTupleGetPointsToTID(itup);
1751  nhtid = psprintf("(%u,%u)",
1754 
1755  ereport(ERROR,
1756  (errcode(ERRCODE_INDEX_CORRUPTED),
1757  errmsg("item order invariant violated for index \"%s\"",
1759  errdetail_internal("Lower index tid=%s (points to %s tid=%s) "
1760  "higher index tid=%s (points to %s tid=%s) "
1761  "page lsn=%X/%X.",
1762  itid,
1763  P_ISLEAF(topaque) ? "heap" : "index",
1764  htid,
1765  nitid,
1766  P_ISLEAF(topaque) ? "heap" : "index",
1767  nhtid,
1768  LSN_FORMAT_ARGS(state->targetlsn))));
1769  }
1770 
1771  /*
1772  * If the index is unique verify entries uniqueness by checking the
1773  * heap tuples visibility.
1774  */
1775  if (state->checkunique && state->indexinfo->ii_Unique &&
1776  P_ISLEAF(topaque) && !skey->anynullkeys)
1777  bt_entry_unique_check(state, itup, state->targetblock, offset,
1778  &lVis_i, &lVis_tid, &lVis_offset,
1779  &lVis_block);
1780 
1781  if (state->checkunique && state->indexinfo->ii_Unique &&
1782  P_ISLEAF(topaque) && OffsetNumberNext(offset) <= max)
1783  {
1784  /* Save current scankey tid */
1785  scantid = skey->scantid;
1786 
1787  /*
1788  * Invalidate scankey tid to make _bt_compare compare only keys in
1789  * the item to report equality even if heap TIDs are different
1790  */
1791  skey->scantid = NULL;
1792 
1793  /*
1794  * If next key tuple is different, invalidate last visible entry
1795  * data (whole index tuple or last posting in index tuple). Key
1796  * containing null value does not violate unique constraint and
1797  * treated as different to any other key.
1798  */
1799  if (_bt_compare(state->rel, skey, state->target,
1800  OffsetNumberNext(offset)) != 0 || skey->anynullkeys)
1801  {
1802  lVis_i = -1;
1803  lVis_tid = NULL;
1804  lVis_block = InvalidBlockNumber;
1805  lVis_offset = InvalidOffsetNumber;
1806  }
1807  skey->scantid = scantid; /* Restore saved scan key state */
1808  }
1809 
1810  /*
1811  * * Last item check *
1812  *
1813  * Check last item against next/right page's first data item's when
1814  * last item on page is reached. This additional check will detect
1815  * transposed pages iff the supposed right sibling page happens to
1816  * belong before target in the key space. (Otherwise, a subsequent
1817  * heap verification will probably detect the problem.)
1818  *
1819  * This check is similar to the item order check that will have
1820  * already been performed for every other "real" item on target page
1821  * when last item is checked. The difference is that the next item
1822  * (the item that is compared to target's last item) needs to come
1823  * from the next/sibling page. There may not be such an item
1824  * available from sibling for various reasons, though (e.g., target is
1825  * the rightmost page on level).
1826  */
1827  if (offset == max)
1828  {
1829  BTScanInsert rightkey;
1830  BlockNumber rightblock_number;
1831 
1832  /* first offset on a right index page (log only) */
1833  OffsetNumber rightfirstoffset = InvalidOffsetNumber;
1834 
1835  /* Get item in next/right page */
1836  rightkey = bt_right_page_check_scankey(state, &rightfirstoffset);
1837 
1838  if (rightkey &&
1839  !invariant_g_offset(state, rightkey, max))
1840  {
1841  /*
1842  * As explained at length in bt_right_page_check_scankey(),
1843  * there is a known !readonly race that could account for
1844  * apparent violation of invariant, which we must check for
1845  * before actually proceeding with raising error. Our canary
1846  * condition is that target page was deleted.
1847  */
1848  if (!state->readonly)
1849  {
1850  /* Get fresh copy of target page */
1851  state->target = palloc_btree_page(state, state->targetblock);
1852  /* Note that we deliberately do not update target LSN */
1853  topaque = BTPageGetOpaque(state->target);
1854 
1855  /*
1856  * All !readonly checks now performed; just return
1857  */
1858  if (P_IGNORE(topaque))
1859  return;
1860  }
1861 
1862  ereport(ERROR,
1863  (errcode(ERRCODE_INDEX_CORRUPTED),
1864  errmsg("cross page item order invariant violated for index \"%s\"",
1866  errdetail_internal("Last item on page tid=(%u,%u) page lsn=%X/%X.",
1867  state->targetblock, offset,
1868  LSN_FORMAT_ARGS(state->targetlsn))));
1869  }
1870 
1871  /*
1872  * If index has unique constraint make sure that no more than one
1873  * found equal items is visible.
1874  */
1875  rightblock_number = topaque->btpo_next;
1876  if (state->checkunique && state->indexinfo->ii_Unique &&
1877  rightkey && P_ISLEAF(topaque) && rightblock_number != P_NONE)
1878  {
1879  elog(DEBUG2, "check cross page unique condition");
1880 
1881  /*
1882  * Make _bt_compare compare only index keys without heap TIDs.
1883  * rightkey->scantid is modified destructively but it is ok
1884  * for it is not used later.
1885  */
1886  rightkey->scantid = NULL;
1887 
1888  /* The first key on the next page is the same */
1889  if (_bt_compare(state->rel, rightkey, state->target, max) == 0 && !rightkey->anynullkeys)
1890  {
1891  elog(DEBUG2, "cross page equal keys");
1892  state->target = palloc_btree_page(state,
1893  rightblock_number);
1894  topaque = BTPageGetOpaque(state->target);
1895 
1896  if (P_IGNORE(topaque) || !P_ISLEAF(topaque))
1897  break;
1898 
1899  itemid = PageGetItemIdCareful(state, rightblock_number,
1900  state->target,
1901  rightfirstoffset);
1902  itup = (IndexTuple) PageGetItem(state->target, itemid);
1903 
1904  bt_entry_unique_check(state, itup, rightblock_number, rightfirstoffset,
1905  &lVis_i, &lVis_tid, &lVis_offset,
1906  &lVis_block);
1907  }
1908  }
1909  }
1910 
1911  /*
1912  * * Downlink check *
1913  *
1914  * Additional check of child items iff this is an internal page and
1915  * caller holds a ShareLock. This happens for every downlink (item)
1916  * in target excluding the negative-infinity downlink (again, this is
1917  * because it has no useful value to compare).
1918  */
1919  if (!P_ISLEAF(topaque) && state->readonly)
1920  bt_child_check(state, skey, offset);
1921  }
1922 
1923  /*
1924  * Special case bt_child_highkey_check() call
1925  *
1926  * We don't pass a real downlink, but we've to finish the level
1927  * processing. If condition is satisfied, we've already processed all the
1928  * downlinks from the target level. But there still might be pages to the
1929  * right of the child page pointer to by our rightmost downlink. And they
1930  * might have missing downlinks. This final call checks for them.
1931  */
1932  if (!P_ISLEAF(topaque) && P_RIGHTMOST(topaque) && state->readonly)
1933  {
1935  NULL, topaque->btpo_level);
1936  }
1937 }
1938 
1939 /*
1940  * Return a scankey for an item on page to right of current target (or the
1941  * first non-ignorable page), sufficient to check ordering invariant on last
1942  * item in current target page. Returned scankey relies on local memory
1943  * allocated for the child page, which caller cannot pfree(). Caller's memory
1944  * context should be reset between calls here.
1945  *
1946  * This is the first data item, and so all adjacent items are checked against
1947  * their immediate sibling item (which may be on a sibling page, or even a
1948  * "cousin" page at parent boundaries where target's rightlink points to page
1949  * with different parent page). If no such valid item is available, return
1950  * NULL instead.
1951  *
1952  * Note that !readonly callers must reverify that target page has not
1953  * been concurrently deleted.
1954  *
1955  * Save rightfirstdataoffset for detailed error message.
1956  */
1957 static BTScanInsert
1959 {
1960  BTPageOpaque opaque;
1961  ItemId rightitem;
1962  IndexTuple firstitup;
1963  BlockNumber targetnext;
1964  Page rightpage;
1965  OffsetNumber nline;
1966 
1967  /* Determine target's next block number */
1968  opaque = BTPageGetOpaque(state->target);
1969 
1970  /* If target is already rightmost, no right sibling; nothing to do here */
1971  if (P_RIGHTMOST(opaque))
1972  return NULL;
1973 
1974  /*
1975  * General notes on concurrent page splits and page deletion:
1976  *
1977  * Routines like _bt_search() don't require *any* page split interlock
1978  * when descending the tree, including something very light like a buffer
1979  * pin. That's why it's okay that we don't either. This avoidance of any
1980  * need to "couple" buffer locks is the raison d' etre of the Lehman & Yao
1981  * algorithm, in fact.
1982  *
1983  * That leaves deletion. A deleted page won't actually be recycled by
1984  * VACUUM early enough for us to fail to at least follow its right link
1985  * (or left link, or downlink) and find its sibling, because recycling
1986  * does not occur until no possible index scan could land on the page.
1987  * Index scans can follow links with nothing more than their snapshot as
1988  * an interlock and be sure of at least that much. (See page
1989  * recycling/"visible to everyone" notes in nbtree README.)
1990  *
1991  * Furthermore, it's okay if we follow a rightlink and find a half-dead or
1992  * dead (ignorable) page one or more times. There will either be a
1993  * further right link to follow that leads to a live page before too long
1994  * (before passing by parent's rightmost child), or we will find the end
1995  * of the entire level instead (possible when parent page is itself the
1996  * rightmost on its level).
1997  */
1998  targetnext = opaque->btpo_next;
1999  for (;;)
2000  {
2002 
2003  rightpage = palloc_btree_page(state, targetnext);
2004  opaque = BTPageGetOpaque(rightpage);
2005 
2006  if (!P_IGNORE(opaque) || P_RIGHTMOST(opaque))
2007  break;
2008 
2009  /*
2010  * We landed on a deleted or half-dead sibling page. Step right until
2011  * we locate a live sibling page.
2012  */
2013  ereport(DEBUG2,
2014  (errcode(ERRCODE_NO_DATA),
2015  errmsg_internal("level %u sibling page in block %u of index \"%s\" was found deleted or half dead",
2016  opaque->btpo_level, targetnext, RelationGetRelationName(state->rel)),
2017  errdetail_internal("Deleted page found when building scankey from right sibling.")));
2018 
2019  targetnext = opaque->btpo_next;
2020 
2021  /* Be slightly more pro-active in freeing this memory, just in case */
2022  pfree(rightpage);
2023  }
2024 
2025  /*
2026  * No ShareLock held case -- why it's safe to proceed.
2027  *
2028  * Problem:
2029  *
2030  * We must avoid false positive reports of corruption when caller treats
2031  * item returned here as an upper bound on target's last item. In
2032  * general, false positives are disallowed. Avoiding them here when
2033  * caller is !readonly is subtle.
2034  *
2035  * A concurrent page deletion by VACUUM of the target page can result in
2036  * the insertion of items on to this right sibling page that would
2037  * previously have been inserted on our target page. There might have
2038  * been insertions that followed the target's downlink after it was made
2039  * to point to right sibling instead of target by page deletion's first
2040  * phase. The inserters insert items that would belong on target page.
2041  * This race is very tight, but it's possible. This is our only problem.
2042  *
2043  * Non-problems:
2044  *
2045  * We are not hindered by a concurrent page split of the target; we'll
2046  * never land on the second half of the page anyway. A concurrent split
2047  * of the right page will also not matter, because the first data item
2048  * remains the same within the left half, which we'll reliably land on. If
2049  * we had to skip over ignorable/deleted pages, it cannot matter because
2050  * their key space has already been atomically merged with the first
2051  * non-ignorable page we eventually find (doesn't matter whether the page
2052  * we eventually find is a true sibling or a cousin of target, which we go
2053  * into below).
2054  *
2055  * Solution:
2056  *
2057  * Caller knows that it should reverify that target is not ignorable
2058  * (half-dead or deleted) when cross-page sibling item comparison appears
2059  * to indicate corruption (invariant fails). This detects the single race
2060  * condition that exists for caller. This is correct because the
2061  * continued existence of target block as non-ignorable (not half-dead or
2062  * deleted) implies that target page was not merged into from the right by
2063  * deletion; the key space at or after target never moved left. Target's
2064  * parent either has the same downlink to target as before, or a <
2065  * downlink due to deletion at the left of target. Target either has the
2066  * same highkey as before, or a highkey < before when there is a page
2067  * split. (The rightmost concurrently-split-from-target-page page will
2068  * still have the same highkey as target was originally found to have,
2069  * which for our purposes is equivalent to target's highkey itself never
2070  * changing, since we reliably skip over
2071  * concurrently-split-from-target-page pages.)
2072  *
2073  * In simpler terms, we allow that the key space of the target may expand
2074  * left (the key space can move left on the left side of target only), but
2075  * the target key space cannot expand right and get ahead of us without
2076  * our detecting it. The key space of the target cannot shrink, unless it
2077  * shrinks to zero due to the deletion of the original page, our canary
2078  * condition. (To be very precise, we're a bit stricter than that because
2079  * it might just have been that the target page split and only the
2080  * original target page was deleted. We can be more strict, just not more
2081  * lax.)
2082  *
2083  * Top level tree walk caller moves on to next page (makes it the new
2084  * target) following recovery from this race. (cf. The rationale for
2085  * child/downlink verification needing a ShareLock within
2086  * bt_child_check(), where page deletion is also the main source of
2087  * trouble.)
2088  *
2089  * Note that it doesn't matter if right sibling page here is actually a
2090  * cousin page, because in order for the key space to be readjusted in a
2091  * way that causes us issues in next level up (guiding problematic
2092  * concurrent insertions to the cousin from the grandparent rather than to
2093  * the sibling from the parent), there'd have to be page deletion of
2094  * target's parent page (affecting target's parent's downlink in target's
2095  * grandparent page). Internal page deletion only occurs when there are
2096  * no child pages (they were all fully deleted), and caller is checking
2097  * that the target's parent has at least one non-deleted (so
2098  * non-ignorable) child: the target page. (Note that the first phase of
2099  * deletion atomically marks the page to be deleted half-dead/ignorable at
2100  * the same time downlink in its parent is removed, so caller will
2101  * definitely not fail to detect that this happened.)
2102  *
2103  * This trick is inspired by the method backward scans use for dealing
2104  * with concurrent page splits; concurrent page deletion is a problem that
2105  * similarly receives special consideration sometimes (it's possible that
2106  * the backwards scan will re-read its "original" block after failing to
2107  * find a right-link to it, having already moved in the opposite direction
2108  * (right/"forwards") a few times to try to locate one). Just like us,
2109  * that happens only to determine if there was a concurrent page deletion
2110  * of a reference page, and just like us if there was a page deletion of
2111  * that reference page it means we can move on from caring about the
2112  * reference page. See the nbtree README for a full description of how
2113  * that works.
2114  */
2115  nline = PageGetMaxOffsetNumber(rightpage);
2116 
2117  /*
2118  * Get first data item, if any
2119  */
2120  if (P_ISLEAF(opaque) && nline >= P_FIRSTDATAKEY(opaque))
2121  {
2122  /* Return first data item (if any) */
2123  rightitem = PageGetItemIdCareful(state, targetnext, rightpage,
2124  P_FIRSTDATAKEY(opaque));
2125  *rightfirstoffset = P_FIRSTDATAKEY(opaque);
2126  }
2127  else if (!P_ISLEAF(opaque) &&
2128  nline >= OffsetNumberNext(P_FIRSTDATAKEY(opaque)))
2129  {
2130  /*
2131  * Return first item after the internal page's "negative infinity"
2132  * item
2133  */
2134  rightitem = PageGetItemIdCareful(state, targetnext, rightpage,
2135  OffsetNumberNext(P_FIRSTDATAKEY(opaque)));
2136  }
2137  else
2138  {
2139  /*
2140  * No first item. Page is probably empty leaf page, but it's also
2141  * possible that it's an internal page with only a negative infinity
2142  * item.
2143  */
2144  ereport(DEBUG2,
2145  (errcode(ERRCODE_NO_DATA),
2146  errmsg_internal("%s block %u of index \"%s\" has no first data item",
2147  P_ISLEAF(opaque) ? "leaf" : "internal", targetnext,
2148  RelationGetRelationName(state->rel))));
2149  return NULL;
2150  }
2151 
2152  /*
2153  * Return first real item scankey. Note that this relies on right page
2154  * memory remaining allocated.
2155  */
2156  firstitup = (IndexTuple) PageGetItem(rightpage, rightitem);
2157  return bt_mkscankey_pivotsearch(state->rel, firstitup);
2158 }
2159 
2160 /*
2161  * Check if two tuples are binary identical except the block number. So,
2162  * this function is capable to compare pivot keys on different levels.
2163  */
2164 static bool
2165 bt_pivot_tuple_identical(bool heapkeyspace, IndexTuple itup1, IndexTuple itup2)
2166 {
2167  if (IndexTupleSize(itup1) != IndexTupleSize(itup2))
2168  return false;
2169 
2170  if (heapkeyspace)
2171  {
2172  /*
2173  * Offset number will contain important information in heapkeyspace
2174  * indexes: the number of attributes left in the pivot tuple following
2175  * suffix truncation. Don't skip over it (compare it too).
2176  */
2177  if (memcmp(&itup1->t_tid.ip_posid, &itup2->t_tid.ip_posid,
2178  IndexTupleSize(itup1) -
2179  offsetof(ItemPointerData, ip_posid)) != 0)
2180  return false;
2181  }
2182  else
2183  {
2184  /*
2185  * Cannot rely on offset number field having consistent value across
2186  * levels on pg_upgrade'd !heapkeyspace indexes. Compare contents of
2187  * tuple starting from just after item pointer (i.e. after block
2188  * number and offset number).
2189  */
2190  if (memcmp(&itup1->t_info, &itup2->t_info,
2191  IndexTupleSize(itup1) -
2192  offsetof(IndexTupleData, t_info)) != 0)
2193  return false;
2194  }
2195 
2196  return true;
2197 }
2198 
2199 /*---
2200  * Check high keys on the child level. Traverse rightlinks from previous
2201  * downlink to the current one. Check that there are no intermediate pages
2202  * with missing downlinks.
2203  *
2204  * If 'loaded_child' is given, it's assumed to be the page pointed to by the
2205  * downlink referenced by 'downlinkoffnum' of the target page.
2206  *
2207  * Basically this function is called for each target downlink and checks two
2208  * invariants:
2209  *
2210  * 1) You can reach the next child from previous one via rightlinks;
2211  * 2) Each child high key have matching pivot key on target level.
2212  *
2213  * Consider the sample tree picture.
2214  *
2215  * 1
2216  * / \
2217  * 2 <-> 3
2218  * / \ / \
2219  * 4 <> 5 <> 6 <> 7 <> 8
2220  *
2221  * This function will be called for blocks 4, 5, 6 and 8. Consider what is
2222  * happening for each function call.
2223  *
2224  * - The function call for block 4 initializes data structure and matches high
2225  * key of block 4 to downlink's pivot key of block 2.
2226  * - The high key of block 5 is matched to the high key of block 2.
2227  * - The block 6 has an incomplete split flag set, so its high key isn't
2228  * matched to anything.
2229  * - The function call for block 8 checks that block 8 can be found while
2230  * following rightlinks from block 6. The high key of block 7 will be
2231  * matched to downlink's pivot key in block 3.
2232  *
2233  * There is also final call of this function, which checks that there is no
2234  * missing downlinks for children to the right of the child referenced by
2235  * rightmost downlink in target level.
2236  */
2237 static void
2239  OffsetNumber target_downlinkoffnum,
2240  Page loaded_child,
2241  uint32 target_level)
2242 {
2243  BlockNumber blkno = state->prevrightlink;
2244  Page page;
2245  BTPageOpaque opaque;
2246  bool rightsplit = state->previncompletesplit;
2247  bool first = true;
2248  ItemId itemid;
2249  IndexTuple itup;
2250  BlockNumber downlink;
2251 
2252  if (OffsetNumberIsValid(target_downlinkoffnum))
2253  {
2254  itemid = PageGetItemIdCareful(state, state->targetblock,
2255  state->target, target_downlinkoffnum);
2256  itup = (IndexTuple) PageGetItem(state->target, itemid);
2257  downlink = BTreeTupleGetDownLink(itup);
2258  }
2259  else
2260  {
2261  downlink = P_NONE;
2262  }
2263 
2264  /*
2265  * If no previous rightlink is memorized for current level just below
2266  * target page's level, we are about to start from the leftmost page. We
2267  * can't follow rightlinks from previous page, because there is no
2268  * previous page. But we still can match high key.
2269  *
2270  * So we initialize variables for the loop above like there is previous
2271  * page referencing current child. Also we imply previous page to not
2272  * have incomplete split flag, that would make us require downlink for
2273  * current child. That's correct, because leftmost page on the level
2274  * should always have parent downlink.
2275  */
2276  if (!BlockNumberIsValid(blkno))
2277  {
2278  blkno = downlink;
2279  rightsplit = false;
2280  }
2281 
2282  /* Move to the right on the child level */
2283  while (true)
2284  {
2285  /*
2286  * Did we traverse the whole tree level and this is check for pages to
2287  * the right of rightmost downlink?
2288  */
2289  if (blkno == P_NONE && downlink == P_NONE)
2290  {
2291  state->prevrightlink = InvalidBlockNumber;
2292  state->previncompletesplit = false;
2293  return;
2294  }
2295 
2296  /* Did we traverse the whole tree level and don't find next downlink? */
2297  if (blkno == P_NONE)
2298  ereport(ERROR,
2299  (errcode(ERRCODE_INDEX_CORRUPTED),
2300  errmsg("can't traverse from downlink %u to downlink %u of index \"%s\"",
2301  state->prevrightlink, downlink,
2302  RelationGetRelationName(state->rel))));
2303 
2304  /* Load page contents */
2305  if (blkno == downlink && loaded_child)
2306  page = loaded_child;
2307  else
2308  page = palloc_btree_page(state, blkno);
2309 
2310  opaque = BTPageGetOpaque(page);
2311 
2312  /* The first page we visit at the level should be leftmost */
2313  if (first && !BlockNumberIsValid(state->prevrightlink) &&
2314  !bt_leftmost_ignoring_half_dead(state, blkno, opaque))
2315  ereport(ERROR,
2316  (errcode(ERRCODE_INDEX_CORRUPTED),
2317  errmsg("the first child of leftmost target page is not leftmost of its level in index \"%s\"",
2319  errdetail_internal("Target block=%u child block=%u target page lsn=%X/%X.",
2320  state->targetblock, blkno,
2321  LSN_FORMAT_ARGS(state->targetlsn))));
2322 
2323  /* Do level sanity check */
2324  if ((!P_ISDELETED(opaque) || P_HAS_FULLXID(opaque)) &&
2325  opaque->btpo_level != target_level - 1)
2326  ereport(ERROR,
2327  (errcode(ERRCODE_INDEX_CORRUPTED),
2328  errmsg("block found while following rightlinks from child of index \"%s\" has invalid level",
2330  errdetail_internal("Block pointed to=%u expected level=%u level in pointed to block=%u.",
2331  blkno, target_level - 1, opaque->btpo_level)));
2332 
2333  /* Try to detect circular links */
2334  if ((!first && blkno == state->prevrightlink) || blkno == opaque->btpo_prev)
2335  ereport(ERROR,
2336  (errcode(ERRCODE_INDEX_CORRUPTED),
2337  errmsg("circular link chain found in block %u of index \"%s\"",
2338  blkno, RelationGetRelationName(state->rel))));
2339 
2340  if (blkno != downlink && !P_IGNORE(opaque))
2341  {
2342  /* blkno probably has missing parent downlink */
2343  bt_downlink_missing_check(state, rightsplit, blkno, page);
2344  }
2345 
2346  rightsplit = P_INCOMPLETE_SPLIT(opaque);
2347 
2348  /*
2349  * If we visit page with high key, check that it is equal to the
2350  * target key next to corresponding downlink.
2351  */
2352  if (!rightsplit && !P_RIGHTMOST(opaque))
2353  {
2354  BTPageOpaque topaque;
2355  IndexTuple highkey;
2356  OffsetNumber pivotkey_offset;
2357 
2358  /* Get high key */
2359  itemid = PageGetItemIdCareful(state, blkno, page, P_HIKEY);
2360  highkey = (IndexTuple) PageGetItem(page, itemid);
2361 
2362  /*
2363  * There might be two situations when we examine high key. If
2364  * current child page is referenced by given target downlink, we
2365  * should look to the next offset number for matching key from
2366  * target page.
2367  *
2368  * Alternatively, we're following rightlinks somewhere in the
2369  * middle between page referenced by previous target's downlink
2370  * and the page referenced by current target's downlink. If
2371  * current child page hasn't incomplete split flag set, then its
2372  * high key should match to the target's key of current offset
2373  * number. This happens when a previous call here (to
2374  * bt_child_highkey_check()) found an incomplete split, and we
2375  * reach a right sibling page without a downlink -- the right
2376  * sibling page's high key still needs to be matched to a
2377  * separator key on the parent/target level.
2378  *
2379  * Don't apply OffsetNumberNext() to target_downlinkoffnum when we
2380  * already had to step right on the child level. Our traversal of
2381  * the child level must try to move in perfect lockstep behind (to
2382  * the left of) the target/parent level traversal.
2383  */
2384  if (blkno == downlink)
2385  pivotkey_offset = OffsetNumberNext(target_downlinkoffnum);
2386  else
2387  pivotkey_offset = target_downlinkoffnum;
2388 
2389  topaque = BTPageGetOpaque(state->target);
2390 
2391  if (!offset_is_negative_infinity(topaque, pivotkey_offset))
2392  {
2393  /*
2394  * If we're looking for the next pivot tuple in target page,
2395  * but there is no more pivot tuples, then we should match to
2396  * high key instead.
2397  */
2398  if (pivotkey_offset > PageGetMaxOffsetNumber(state->target))
2399  {
2400  if (P_RIGHTMOST(topaque))
2401  ereport(ERROR,
2402  (errcode(ERRCODE_INDEX_CORRUPTED),
2403  errmsg("child high key is greater than rightmost pivot key on target level in index \"%s\"",
2405  errdetail_internal("Target block=%u child block=%u target page lsn=%X/%X.",
2406  state->targetblock, blkno,
2407  LSN_FORMAT_ARGS(state->targetlsn))));
2408  pivotkey_offset = P_HIKEY;
2409  }
2410  itemid = PageGetItemIdCareful(state, state->targetblock,
2411  state->target, pivotkey_offset);
2412  itup = (IndexTuple) PageGetItem(state->target, itemid);
2413  }
2414  else
2415  {
2416  /*
2417  * We cannot try to match child's high key to a negative
2418  * infinity key in target, since there is nothing to compare.
2419  * However, it's still possible to match child's high key
2420  * outside of target page. The reason why we're are is that
2421  * bt_child_highkey_check() was previously called for the
2422  * cousin page of 'loaded_child', which is incomplete split.
2423  * So, now we traverse to the right of that cousin page and
2424  * current child level page under consideration still belongs
2425  * to the subtree of target's left sibling. Thus, we need to
2426  * match child's high key to it's left uncle page high key.
2427  * Thankfully we saved it, it's called a "low key" of target
2428  * page.
2429  */
2430  if (!state->lowkey)
2431  ereport(ERROR,
2432  (errcode(ERRCODE_INDEX_CORRUPTED),
2433  errmsg("can't find left sibling high key in index \"%s\"",
2435  errdetail_internal("Target block=%u child block=%u target page lsn=%X/%X.",
2436  state->targetblock, blkno,
2437  LSN_FORMAT_ARGS(state->targetlsn))));
2438  itup = state->lowkey;
2439  }
2440 
2441  if (!bt_pivot_tuple_identical(state->heapkeyspace, highkey, itup))
2442  {
2443  ereport(ERROR,
2444  (errcode(ERRCODE_INDEX_CORRUPTED),
2445  errmsg("mismatch between parent key and child high key in index \"%s\"",
2447  errdetail_internal("Target block=%u child block=%u target page lsn=%X/%X.",
2448  state->targetblock, blkno,
2449  LSN_FORMAT_ARGS(state->targetlsn))));
2450  }
2451  }
2452 
2453  /* Exit if we already found next downlink */
2454  if (blkno == downlink)
2455  {
2456  state->prevrightlink = opaque->btpo_next;
2457  state->previncompletesplit = rightsplit;
2458  return;
2459  }
2460 
2461  /* Traverse to the next page using rightlink */
2462  blkno = opaque->btpo_next;
2463 
2464  /* Free page contents if it's allocated by us */
2465  if (page != loaded_child)
2466  pfree(page);
2467  first = false;
2468  }
2469 }
2470 
2471 /*
2472  * Checks one of target's downlink against its child page.
2473  *
2474  * Conceptually, the target page continues to be what is checked here. The
2475  * target block is still blamed in the event of finding an invariant violation.
2476  * The downlink insertion into the target is probably where any problem raised
2477  * here arises, and there is no such thing as a parent link, so doing the
2478  * verification this way around is much more practical.
2479  *
2480  * This function visits child page and it's sequentially called for each
2481  * downlink of target page. Assuming this we also check downlink connectivity
2482  * here in order to save child page visits.
2483  */
2484 static void
2486  OffsetNumber downlinkoffnum)
2487 {
2488  ItemId itemid;
2489  IndexTuple itup;
2490  BlockNumber childblock;
2491  OffsetNumber offset;
2492  OffsetNumber maxoffset;
2493  Page child;
2494  BTPageOpaque copaque;
2495  BTPageOpaque topaque;
2496 
2497  itemid = PageGetItemIdCareful(state, state->targetblock,
2498  state->target, downlinkoffnum);
2499  itup = (IndexTuple) PageGetItem(state->target, itemid);
2500  childblock = BTreeTupleGetDownLink(itup);
2501 
2502  /*
2503  * Caller must have ShareLock on target relation, because of
2504  * considerations around page deletion by VACUUM.
2505  *
2506  * NB: In general, page deletion deletes the right sibling's downlink, not
2507  * the downlink of the page being deleted; the deleted page's downlink is
2508  * reused for its sibling. The key space is thereby consolidated between
2509  * the deleted page and its right sibling. (We cannot delete a parent
2510  * page's rightmost child unless it is the last child page, and we intend
2511  * to also delete the parent itself.)
2512  *
2513  * If this verification happened without a ShareLock, the following race
2514  * condition could cause false positives:
2515  *
2516  * In general, concurrent page deletion might occur, including deletion of
2517  * the left sibling of the child page that is examined here. If such a
2518  * page deletion were to occur, closely followed by an insertion into the
2519  * newly expanded key space of the child, a window for the false positive
2520  * opens up: the stale parent/target downlink originally followed to get
2521  * to the child legitimately ceases to be a lower bound on all items in
2522  * the page, since the key space was concurrently expanded "left".
2523  * (Insertion followed the "new" downlink for the child, not our now-stale
2524  * downlink, which was concurrently physically removed in target/parent as
2525  * part of deletion's first phase.)
2526  *
2527  * While we use various techniques elsewhere to perform cross-page
2528  * verification for !readonly callers, a similar trick seems difficult
2529  * here. The tricks used by bt_recheck_sibling_links and by
2530  * bt_right_page_check_scankey both involve verification of a same-level,
2531  * cross-sibling invariant. Cross-level invariants are far more squishy,
2532  * though. The nbtree REDO routines do not actually couple buffer locks
2533  * across levels during page splits, so making any cross-level check work
2534  * reliably in !readonly mode may be impossible.
2535  */
2536  Assert(state->readonly);
2537 
2538  /*
2539  * Verify child page has the downlink key from target page (its parent) as
2540  * a lower bound; downlink must be strictly less than all keys on the
2541  * page.
2542  *
2543  * Check all items, rather than checking just the first and trusting that
2544  * the operator class obeys the transitive law.
2545  */
2546  topaque = BTPageGetOpaque(state->target);
2547  child = palloc_btree_page(state, childblock);
2548  copaque = BTPageGetOpaque(child);
2549  maxoffset = PageGetMaxOffsetNumber(child);
2550 
2551  /*
2552  * Since we've already loaded the child block, combine this check with
2553  * check for downlink connectivity.
2554  */
2555  bt_child_highkey_check(state, downlinkoffnum,
2556  child, topaque->btpo_level);
2557 
2558  /*
2559  * Since there cannot be a concurrent VACUUM operation in readonly mode,
2560  * and since a page has no links within other pages (siblings and parent)
2561  * once it is marked fully deleted, it should be impossible to land on a
2562  * fully deleted page.
2563  *
2564  * It does not quite make sense to enforce that the page cannot even be
2565  * half-dead, despite the fact the downlink is modified at the same stage
2566  * that the child leaf page is marked half-dead. That's incorrect because
2567  * there may occasionally be multiple downlinks from a chain of pages
2568  * undergoing deletion, where multiple successive calls are made to
2569  * _bt_unlink_halfdead_page() by VACUUM before it can finally safely mark
2570  * the leaf page as fully dead. While _bt_mark_page_halfdead() usually
2571  * removes the downlink to the leaf page that is marked half-dead, that's
2572  * not guaranteed, so it's possible we'll land on a half-dead page with a
2573  * downlink due to an interrupted multi-level page deletion.
2574  *
2575  * We go ahead with our checks if the child page is half-dead. It's safe
2576  * to do so because we do not test the child's high key, so it does not
2577  * matter that the original high key will have been replaced by a dummy
2578  * truncated high key within _bt_mark_page_halfdead(). All other page
2579  * items are left intact on a half-dead page, so there is still something
2580  * to test.
2581  */
2582  if (P_ISDELETED(copaque))
2583  ereport(ERROR,
2584  (errcode(ERRCODE_INDEX_CORRUPTED),
2585  errmsg("downlink to deleted page found in index \"%s\"",
2587  errdetail_internal("Parent block=%u child block=%u parent page lsn=%X/%X.",
2588  state->targetblock, childblock,
2589  LSN_FORMAT_ARGS(state->targetlsn))));
2590 
2591  for (offset = P_FIRSTDATAKEY(copaque);
2592  offset <= maxoffset;
2593  offset = OffsetNumberNext(offset))
2594  {
2595  /*
2596  * Skip comparison of target page key against "negative infinity"
2597  * item, if any. Checking it would indicate that it's not a strict
2598  * lower bound, but that's only because of the hard-coding for
2599  * negative infinity items within _bt_compare().
2600  *
2601  * If nbtree didn't truncate negative infinity tuples during internal
2602  * page splits then we'd expect child's negative infinity key to be
2603  * equal to the scankey/downlink from target/parent (it would be a
2604  * "low key" in this hypothetical scenario, and so it would still need
2605  * to be treated as a special case here).
2606  *
2607  * Negative infinity items can be thought of as a strict lower bound
2608  * that works transitively, with the last non-negative-infinity pivot
2609  * followed during a descent from the root as its "true" strict lower
2610  * bound. Only a small number of negative infinity items are truly
2611  * negative infinity; those that are the first items of leftmost
2612  * internal pages. In more general terms, a negative infinity item is
2613  * only negative infinity with respect to the subtree that the page is
2614  * at the root of.
2615  *
2616  * See also: bt_rootdescend(), which can even detect transitive
2617  * inconsistencies on cousin leaf pages.
2618  */
2619  if (offset_is_negative_infinity(copaque, offset))
2620  continue;
2621 
2622  if (!invariant_l_nontarget_offset(state, targetkey, childblock, child,
2623  offset))
2624  ereport(ERROR,
2625  (errcode(ERRCODE_INDEX_CORRUPTED),
2626  errmsg("down-link lower bound invariant violated for index \"%s\"",
2628  errdetail_internal("Parent block=%u child index tid=(%u,%u) parent page lsn=%X/%X.",
2629  state->targetblock, childblock, offset,
2630  LSN_FORMAT_ARGS(state->targetlsn))));
2631  }
2632 
2633  pfree(child);
2634 }
2635 
2636 /*
2637  * Checks if page is missing a downlink that it should have.
2638  *
2639  * A page that lacks a downlink/parent may indicate corruption. However, we
2640  * must account for the fact that a missing downlink can occasionally be
2641  * encountered in a non-corrupt index. This can be due to an interrupted page
2642  * split, or an interrupted multi-level page deletion (i.e. there was a hard
2643  * crash or an error during a page split, or while VACUUM was deleting a
2644  * multi-level chain of pages).
2645  *
2646  * Note that this can only be called in readonly mode, so there is no need to
2647  * be concerned about concurrent page splits or page deletions.
2648  */
2649 static void
2651  BlockNumber blkno, Page page)
2652 {
2653  BTPageOpaque opaque = BTPageGetOpaque(page);
2654  ItemId itemid;
2655  IndexTuple itup;
2656  Page child;
2657  BTPageOpaque copaque;
2658  uint32 level;
2659  BlockNumber childblk;
2660  XLogRecPtr pagelsn;
2661 
2662  Assert(state->readonly);
2663  Assert(!P_IGNORE(opaque));
2664 
2665  /* No next level up with downlinks to fingerprint from the true root */
2666  if (P_ISROOT(opaque))
2667  return;
2668 
2669  pagelsn = PageGetLSN(page);
2670 
2671  /*
2672  * Incomplete (interrupted) page splits can account for the lack of a
2673  * downlink. Some inserting transaction should eventually complete the
2674  * page split in passing, when it notices that the left sibling page is
2675  * P_INCOMPLETE_SPLIT().
2676  *
2677  * In general, VACUUM is not prepared for there to be no downlink to a
2678  * page that it deletes. This is the main reason why the lack of a
2679  * downlink can be reported as corruption here. It's not obvious that an
2680  * invalid missing downlink can result in wrong answers to queries,
2681  * though, since index scans that land on the child may end up
2682  * consistently moving right. The handling of concurrent page splits (and
2683  * page deletions) within _bt_moveright() cannot distinguish
2684  * inconsistencies that last for a moment from inconsistencies that are
2685  * permanent and irrecoverable.
2686  *
2687  * VACUUM isn't even prepared to delete pages that have no downlink due to
2688  * an incomplete page split, but it can detect and reason about that case
2689  * by design, so it shouldn't be taken to indicate corruption. See
2690  * _bt_pagedel() for full details.
2691  */
2692  if (rightsplit)
2693  {
2694  ereport(DEBUG1,
2695  (errcode(ERRCODE_NO_DATA),
2696  errmsg_internal("harmless interrupted page split detected in index \"%s\"",
2698  errdetail_internal("Block=%u level=%u left sibling=%u page lsn=%X/%X.",
2699  blkno, opaque->btpo_level,
2700  opaque->btpo_prev,
2701  LSN_FORMAT_ARGS(pagelsn))));
2702  return;
2703  }
2704 
2705  /*
2706  * Page under check is probably the "top parent" of a multi-level page
2707  * deletion. We'll need to descend the subtree to make sure that
2708  * descendant pages are consistent with that, though.
2709  *
2710  * If the page (which must be non-ignorable) is a leaf page, then clearly
2711  * it can't be the top parent. The lack of a downlink is probably a
2712  * symptom of a broad problem that could just as easily cause
2713  * inconsistencies anywhere else.
2714  */
2715  if (P_ISLEAF(opaque))
2716  ereport(ERROR,
2717  (errcode(ERRCODE_INDEX_CORRUPTED),
2718  errmsg("leaf index block lacks downlink in index \"%s\"",
2720  errdetail_internal("Block=%u page lsn=%X/%X.",
2721  blkno,
2722  LSN_FORMAT_ARGS(pagelsn))));
2723 
2724  /* Descend from the given page, which is an internal page */
2725  elog(DEBUG1, "checking for interrupted multi-level deletion due to missing downlink in index \"%s\"",
2727 
2728  level = opaque->btpo_level;
2729  itemid = PageGetItemIdCareful(state, blkno, page, P_FIRSTDATAKEY(opaque));
2730  itup = (IndexTuple) PageGetItem(page, itemid);
2731  childblk = BTreeTupleGetDownLink(itup);
2732  for (;;)
2733  {
2735 
2736  child = palloc_btree_page(state, childblk);
2737  copaque = BTPageGetOpaque(child);
2738 
2739  if (P_ISLEAF(copaque))
2740  break;
2741 
2742  /* Do an extra sanity check in passing on internal pages */
2743  if (copaque->btpo_level != level - 1)
2744  ereport(ERROR,
2745  (errcode(ERRCODE_INDEX_CORRUPTED),
2746  errmsg_internal("downlink points to block in index \"%s\" whose level is not one level down",
2748  errdetail_internal("Top parent/under check block=%u block pointed to=%u expected level=%u level in pointed to block=%u.",
2749  blkno, childblk,
2750  level - 1, copaque->btpo_level)));
2751 
2752  level = copaque->btpo_level;
2753  itemid = PageGetItemIdCareful(state, childblk, child,
2754  P_FIRSTDATAKEY(copaque));
2755  itup = (IndexTuple) PageGetItem(child, itemid);
2756  childblk = BTreeTupleGetDownLink(itup);
2757  /* Be slightly more pro-active in freeing this memory, just in case */
2758  pfree(child);
2759  }
2760 
2761  /*
2762  * Since there cannot be a concurrent VACUUM operation in readonly mode,
2763  * and since a page has no links within other pages (siblings and parent)
2764  * once it is marked fully deleted, it should be impossible to land on a
2765  * fully deleted page. See bt_child_check() for further details.
2766  *
2767  * The bt_child_check() P_ISDELETED() check is repeated here because
2768  * bt_child_check() does not visit pages reachable through negative
2769  * infinity items. Besides, bt_child_check() is unwilling to descend
2770  * multiple levels. (The similar bt_child_check() P_ISDELETED() check
2771  * within bt_check_level_from_leftmost() won't reach the page either,
2772  * since the leaf's live siblings should have their sibling links updated
2773  * to bypass the deletion target page when it is marked fully dead.)
2774  *
2775  * If this error is raised, it might be due to a previous multi-level page
2776  * deletion that failed to realize that it wasn't yet safe to mark the
2777  * leaf page as fully dead. A "dangling downlink" will still remain when
2778  * this happens. The fact that the dangling downlink's page (the leaf's
2779  * parent/ancestor page) lacked a downlink is incidental.
2780  */
2781  if (P_ISDELETED(copaque))
2782  ereport(ERROR,
2783  (errcode(ERRCODE_INDEX_CORRUPTED),
2784  errmsg_internal("downlink to deleted leaf page found in index \"%s\"",
2786  errdetail_internal("Top parent/target block=%u leaf block=%u top parent/under check lsn=%X/%X.",
2787  blkno, childblk,
2788  LSN_FORMAT_ARGS(pagelsn))));
2789 
2790  /*
2791  * Iff leaf page is half-dead, its high key top parent link should point
2792  * to what VACUUM considered to be the top parent page at the instant it
2793  * was interrupted. Provided the high key link actually points to the
2794  * page under check, the missing downlink we detected is consistent with
2795  * there having been an interrupted multi-level page deletion. This means
2796  * that the subtree with the page under check at its root (a page deletion
2797  * chain) is in a consistent state, enabling VACUUM to resume deleting the
2798  * entire chain the next time it encounters the half-dead leaf page.
2799  */
2800  if (P_ISHALFDEAD(copaque) && !P_RIGHTMOST(copaque))
2801  {
2802  itemid = PageGetItemIdCareful(state, childblk, child, P_HIKEY);
2803  itup = (IndexTuple) PageGetItem(child, itemid);
2804  if (BTreeTupleGetTopParent(itup) == blkno)
2805  return;
2806  }
2807 
2808  ereport(ERROR,
2809  (errcode(ERRCODE_INDEX_CORRUPTED),
2810  errmsg("internal index block lacks downlink in index \"%s\"",
2812  errdetail_internal("Block=%u level=%u page lsn=%X/%X.",
2813  blkno, opaque->btpo_level,
2814  LSN_FORMAT_ARGS(pagelsn))));
2815 }
2816 
2817 /*
2818  * Per-tuple callback from table_index_build_scan, used to determine if index has
2819  * all the entries that definitely should have been observed in leaf pages of
2820  * the target index (that is, all IndexTuples that were fingerprinted by our
2821  * Bloom filter). All heapallindexed checks occur here.
2822  *
2823  * The redundancy between an index and the table it indexes provides a good
2824  * opportunity to detect corruption, especially corruption within the table.
2825  * The high level principle behind the verification performed here is that any
2826  * IndexTuple that should be in an index following a fresh CREATE INDEX (based
2827  * on the same index definition) should also have been in the original,
2828  * existing index, which should have used exactly the same representation
2829  *
2830  * Since the overall structure of the index has already been verified, the most
2831  * likely explanation for error here is a corrupt heap page (could be logical
2832  * or physical corruption). Index corruption may still be detected here,
2833  * though. Only readonly callers will have verified that left links and right
2834  * links are in agreement, and so it's possible that a leaf page transposition
2835  * within index is actually the source of corruption detected here (for
2836  * !readonly callers). The checks performed only for readonly callers might
2837  * more accurately frame the problem as a cross-page invariant issue (this
2838  * could even be due to recovery not replaying all WAL records). The !readonly
2839  * ERROR message raised here includes a HINT about retrying with readonly
2840  * verification, just in case it's a cross-page invariant issue, though that
2841  * isn't particularly likely.
2842  *
2843  * table_index_build_scan() expects to be able to find the root tuple when a
2844  * heap-only tuple (the live tuple at the end of some HOT chain) needs to be
2845  * indexed, in order to replace the actual tuple's TID with the root tuple's
2846  * TID (which is what we're actually passed back here). The index build heap
2847  * scan code will raise an error when a tuple that claims to be the root of the
2848  * heap-only tuple's HOT chain cannot be located. This catches cases where the
2849  * original root item offset/root tuple for a HOT chain indicates (for whatever
2850  * reason) that the entire HOT chain is dead, despite the fact that the latest
2851  * heap-only tuple should be indexed. When this happens, sequential scans may
2852  * always give correct answers, and all indexes may be considered structurally
2853  * consistent (i.e. the nbtree structural checks would not detect corruption).
2854  * It may be the case that only index scans give wrong answers, and yet heap or
2855  * SLRU corruption is the real culprit. (While it's true that LP_DEAD bit
2856  * setting will probably also leave the index in a corrupt state before too
2857  * long, the problem is nonetheless that there is heap corruption.)
2858  *
2859  * Heap-only tuple handling within table_index_build_scan() works in a way that
2860  * helps us to detect index tuples that contain the wrong values (values that
2861  * don't match the latest tuple in the HOT chain). This can happen when there
2862  * is no superseding index tuple due to a faulty assessment of HOT safety,
2863  * perhaps during the original CREATE INDEX. Because the latest tuple's
2864  * contents are used with the root TID, an error will be raised when a tuple
2865  * with the same TID but non-matching attribute values is passed back to us.
2866  * Faulty assessment of HOT-safety was behind at least two distinct CREATE
2867  * INDEX CONCURRENTLY bugs that made it into stable releases, one of which was
2868  * undetected for many years. In short, the same principle that allows a
2869  * REINDEX to repair corruption when there was an (undetected) broken HOT chain
2870  * also allows us to detect the corruption in many cases.
2871  */
2872 static void
2874  bool *isnull, bool tupleIsAlive, void *checkstate)
2875 {
2876  BtreeCheckState *state = (BtreeCheckState *) checkstate;
2877  IndexTuple itup,
2878  norm;
2879 
2880  Assert(state->heapallindexed);
2881 
2882  /* Generate a normalized index tuple for fingerprinting */
2883  itup = index_form_tuple(RelationGetDescr(index), values, isnull);
2884  itup->t_tid = *tid;
2885  norm = bt_normalize_tuple(state, itup);
2886 
2887  /* Probe Bloom filter -- tuple should be present */
2888  if (bloom_lacks_element(state->filter, (unsigned char *) norm,
2889  IndexTupleSize(norm)))
2890  ereport(ERROR,
2892  errmsg("heap tuple (%u,%u) from table \"%s\" lacks matching index tuple within index \"%s\"",
2893  ItemPointerGetBlockNumber(&(itup->t_tid)),
2895  RelationGetRelationName(state->heaprel),
2897  !state->readonly
2898  ? errhint("Retrying verification using the function bt_index_parent_check() might provide a more specific error.")
2899  : 0));
2900 
2901  state->heaptuplespresent++;
2902  pfree(itup);
2903  /* Cannot leak memory here */
2904  if (norm != itup)
2905  pfree(norm);
2906 }
2907 
2908 /*
2909  * Normalize an index tuple for fingerprinting.
2910  *
2911  * In general, index tuple formation is assumed to be deterministic by
2912  * heapallindexed verification, and IndexTuples are assumed immutable. While
2913  * the LP_DEAD bit is mutable in leaf pages, that's ItemId metadata, which is
2914  * not fingerprinted. Normalization is required to compensate for corner
2915  * cases where the determinism assumption doesn't quite work.
2916  *
2917  * There is currently one such case: index_form_tuple() does not try to hide
2918  * the source TOAST state of input datums. The executor applies TOAST
2919  * compression for heap tuples based on different criteria to the compression
2920  * applied within btinsert()'s call to index_form_tuple(): it sometimes
2921  * compresses more aggressively, resulting in compressed heap tuple datums but
2922  * uncompressed corresponding index tuple datums. A subsequent heapallindexed
2923  * verification will get a logically equivalent though bitwise unequal tuple
2924  * from index_form_tuple(). False positive heapallindexed corruption reports
2925  * could occur without normalizing away the inconsistency.
2926  *
2927  * Returned tuple is often caller's own original tuple. Otherwise, it is a
2928  * new representation of caller's original index tuple, palloc()'d in caller's
2929  * memory context.
2930  *
2931  * Note: This routine is not concerned with distinctions about the
2932  * representation of tuples beyond those that might break heapallindexed
2933  * verification. In particular, it won't try to normalize opclass-equal
2934  * datums with potentially distinct representations (e.g., btree/numeric_ops
2935  * index datums will not get their display scale normalized-away here).
2936  * Caller does normalization for non-pivot tuples that have a posting list,
2937  * since dummy CREATE INDEX callback code generates new tuples with the same
2938  * normalized representation.
2939  */
2940 static IndexTuple
2942 {
2943  TupleDesc tupleDescriptor = RelationGetDescr(state->rel);
2944  Datum normalized[INDEX_MAX_KEYS];
2945  bool isnull[INDEX_MAX_KEYS];
2946  bool toast_free[INDEX_MAX_KEYS];
2947  bool formnewtup = false;
2948  IndexTuple reformed;
2949  int i;
2950 
2951  /* Caller should only pass "logical" non-pivot tuples here */
2952  Assert(!BTreeTupleIsPosting(itup) && !BTreeTupleIsPivot(itup));
2953 
2954  /* Easy case: It's immediately clear that tuple has no varlena datums */
2955  if (!IndexTupleHasVarwidths(itup))
2956  return itup;
2957 
2958  for (i = 0; i < tupleDescriptor->natts; i++)
2959  {
2960  Form_pg_attribute att;
2961 
2962  att = TupleDescAttr(tupleDescriptor, i);
2963 
2964  /* Assume untoasted/already normalized datum initially */
2965  toast_free[i] = false;
2966  normalized[i] = index_getattr(itup, att->attnum,
2967  tupleDescriptor,
2968  &isnull[i]);
2969  if (att->attbyval || att->attlen != -1 || isnull[i])
2970  continue;
2971 
2972  /*
2973  * Callers always pass a tuple that could safely be inserted into the
2974  * index without further processing, so an external varlena header
2975  * should never be encountered here
2976  */
2977  if (VARATT_IS_EXTERNAL(DatumGetPointer(normalized[i])))
2978  ereport(ERROR,
2979  (errcode(ERRCODE_INDEX_CORRUPTED),
2980  errmsg("external varlena datum in tuple that references heap row (%u,%u) in index \"%s\"",
2981  ItemPointerGetBlockNumber(&(itup->t_tid)),
2983  RelationGetRelationName(state->rel))));
2984  else if (VARATT_IS_COMPRESSED(DatumGetPointer(normalized[i])))
2985  {
2986  formnewtup = true;
2987  normalized[i] = PointerGetDatum(PG_DETOAST_DATUM(normalized[i]));
2988  toast_free[i] = true;
2989  }
2990  }
2991 
2992  /* Easier case: Tuple has varlena datums, none of which are compressed */
2993  if (!formnewtup)
2994  return itup;
2995 
2996  /*
2997  * Hard case: Tuple had compressed varlena datums that necessitate
2998  * creating normalized version of the tuple from uncompressed input datums
2999  * (normalized input datums). This is rather naive, but shouldn't be
3000  * necessary too often.
3001  *
3002  * Note that we rely on deterministic index_form_tuple() TOAST compression
3003  * of normalized input.
3004  */
3005  reformed = index_form_tuple(tupleDescriptor, normalized, isnull);
3006  reformed->t_tid = itup->t_tid;
3007 
3008  /* Cannot leak memory here */
3009  for (i = 0; i < tupleDescriptor->natts; i++)
3010  if (toast_free[i])
3011  pfree(DatumGetPointer(normalized[i]));
3012 
3013  return reformed;
3014 }
3015 
3016 /*
3017  * Produce palloc()'d "plain" tuple for nth posting list entry/TID.
3018  *
3019  * In general, deduplication is not supposed to change the logical contents of
3020  * an index. Multiple index tuples are merged together into one equivalent
3021  * posting list index tuple when convenient.
3022  *
3023  * heapallindexed verification must normalize-away this variation in
3024  * representation by converting posting list tuples into two or more "plain"
3025  * tuples. Each tuple must be fingerprinted separately -- there must be one
3026  * tuple for each corresponding Bloom filter probe during the heap scan.
3027  *
3028  * Note: Caller still needs to call bt_normalize_tuple() with returned tuple.
3029  */
3030 static inline IndexTuple
3032 {
3033  Assert(BTreeTupleIsPosting(itup));
3034 
3035  /* Returns non-posting-list tuple */
3036  return _bt_form_posting(itup, BTreeTupleGetPostingN(itup, n), 1);
3037 }
3038 
3039 /*
3040  * Search for itup in index, starting from fast root page. itup must be a
3041  * non-pivot tuple. This is only supported with heapkeyspace indexes, since
3042  * we rely on having fully unique keys to find a match with only a single
3043  * visit to a leaf page, barring an interrupted page split, where we may have
3044  * to move right. (A concurrent page split is impossible because caller must
3045  * be readonly caller.)
3046  *
3047  * This routine can detect very subtle transitive consistency issues across
3048  * more than one level of the tree. Leaf pages all have a high key (even the
3049  * rightmost page has a conceptual positive infinity high key), but not a low
3050  * key. Their downlink in parent is a lower bound, which along with the high
3051  * key is almost enough to detect every possible inconsistency. A downlink
3052  * separator key value won't always be available from parent, though, because
3053  * the first items of internal pages are negative infinity items, truncated
3054  * down to zero attributes during internal page splits. While it's true that
3055  * bt_child_check() and the high key check can detect most imaginable key
3056  * space problems, there are remaining problems it won't detect with non-pivot
3057  * tuples in cousin leaf pages. Starting a search from the root for every
3058  * existing leaf tuple detects small inconsistencies in upper levels of the
3059  * tree that cannot be detected any other way. (Besides all this, this is
3060  * probably also useful as a direct test of the code used by index scans
3061  * themselves.)
3062  */
3063 static bool
3065 {
3066  BTScanInsert key;
3067  BTStack stack;
3068  Buffer lbuf;
3069  bool exists;
3070 
3071  key = _bt_mkscankey(state->rel, itup);
3072  Assert(key->heapkeyspace && key->scantid != NULL);
3073 
3074  /*
3075  * Search from root.
3076  *
3077  * Ideally, we would arrange to only move right within _bt_search() when
3078  * an interrupted page split is detected (i.e. when the incomplete split
3079  * bit is found to be set), but for now we accept the possibility that
3080  * that could conceal an inconsistency.
3081  */
3082  Assert(state->readonly && state->rootdescend);
3083  exists = false;
3084  stack = _bt_search(state->rel, NULL, key, &lbuf, BT_READ);
3085 
3086  if (BufferIsValid(lbuf))
3087  {
3088  BTInsertStateData insertstate;
3089  OffsetNumber offnum;
3090  Page page;
3091 
3092  insertstate.itup = itup;
3093  insertstate.itemsz = MAXALIGN(IndexTupleSize(itup));
3094  insertstate.itup_key = key;
3095  insertstate.postingoff = 0;
3096  insertstate.bounds_valid = false;
3097  insertstate.buf = lbuf;
3098 
3099  /* Get matching tuple on leaf page */
3100  offnum = _bt_binsrch_insert(state->rel, &insertstate);
3101  /* Compare first >= matching item on leaf page, if any */
3102  page = BufferGetPage(lbuf);
3103  /* Should match on first heap TID when tuple has a posting list */
3104  if (offnum <= PageGetMaxOffsetNumber(page) &&
3105  insertstate.postingoff <= 0 &&
3106  _bt_compare(state->rel, key, page, offnum) == 0)
3107  exists = true;
3108  _bt_relbuf(state->rel, lbuf);
3109  }
3110 
3111  _bt_freestack(stack);
3112  pfree(key);
3113 
3114  return exists;
3115 }
3116 
3117 /*
3118  * Is particular offset within page (whose special state is passed by caller)
3119  * the page negative-infinity item?
3120  *
3121  * As noted in comments above _bt_compare(), there is special handling of the
3122  * first data item as a "negative infinity" item. The hard-coding within
3123  * _bt_compare() makes comparing this item for the purposes of verification
3124  * pointless at best, since the IndexTuple only contains a valid TID (a
3125  * reference TID to child page).
3126  */
3127 static inline bool
3129 {
3130  /*
3131  * For internal pages only, the first item after high key, if any, is
3132  * negative infinity item. Internal pages always have a negative infinity
3133  * item, whereas leaf pages never have one. This implies that negative
3134  * infinity item is either first or second line item, or there is none
3135  * within page.
3136  *
3137  * Negative infinity items are a special case among pivot tuples. They
3138  * always have zero attributes, while all other pivot tuples always have
3139  * nkeyatts attributes.
3140  *
3141  * Right-most pages don't have a high key, but could be said to
3142  * conceptually have a "positive infinity" high key. Thus, there is a
3143  * symmetry between down link items in parent pages, and high keys in
3144  * children. Together, they represent the part of the key space that
3145  * belongs to each page in the index. For example, all children of the
3146  * root page will have negative infinity as a lower bound from root
3147  * negative infinity downlink, and positive infinity as an upper bound
3148  * (implicitly, from "imaginary" positive infinity high key in root).
3149  */
3150  return !P_ISLEAF(opaque) && offset == P_FIRSTDATAKEY(opaque);
3151 }
3152 
3153 /*
3154  * Does the invariant hold that the key is strictly less than a given upper
3155  * bound offset item?
3156  *
3157  * Verifies line pointer on behalf of caller.
3158  *
3159  * If this function returns false, convention is that caller throws error due
3160  * to corruption.
3161  */
3162 static inline bool
3164  OffsetNumber upperbound)
3165 {
3166  ItemId itemid;
3167  int32 cmp;
3168 
3169  Assert(!key->nextkey && key->backward);
3170 
3171  /* Verify line pointer before checking tuple */
3172  itemid = PageGetItemIdCareful(state, state->targetblock, state->target,
3173  upperbound);
3174  /* pg_upgrade'd indexes may legally have equal sibling tuples */
3175  if (!key->heapkeyspace)
3176  return invariant_leq_offset(state, key, upperbound);
3177 
3178  cmp = _bt_compare(state->rel, key, state->target, upperbound);
3179 
3180  /*
3181  * _bt_compare() is capable of determining that a scankey with a
3182  * filled-out attribute is greater than pivot tuples where the comparison
3183  * is resolved at a truncated attribute (value of attribute in pivot is
3184  * minus infinity). However, it is not capable of determining that a
3185  * scankey is _less than_ a tuple on the basis of a comparison resolved at
3186  * _scankey_ minus infinity attribute. Complete an extra step to simulate
3187  * having minus infinity values for omitted scankey attribute(s).
3188  */
3189  if (cmp == 0)
3190  {
3191  BTPageOpaque topaque;
3192  IndexTuple ritup;
3193  int uppnkeyatts;
3194  ItemPointer rheaptid;
3195  bool nonpivot;
3196 
3197  ritup = (IndexTuple) PageGetItem(state->target, itemid);
3198  topaque = BTPageGetOpaque(state->target);
3199  nonpivot = P_ISLEAF(topaque) && upperbound >= P_FIRSTDATAKEY(topaque);
3200 
3201  /* Get number of keys + heap TID for item to the right */
3202  uppnkeyatts = BTreeTupleGetNKeyAtts(ritup, state->rel);
3203  rheaptid = BTreeTupleGetHeapTIDCareful(state, ritup, nonpivot);
3204 
3205  /* Heap TID is tiebreaker key attribute */
3206  if (key->keysz == uppnkeyatts)
3207  return key->scantid == NULL && rheaptid != NULL;
3208 
3209  return key->keysz < uppnkeyatts;
3210  }
3211 
3212  return cmp < 0;
3213 }
3214 
3215 /*
3216  * Does the invariant hold that the key is less than or equal to a given upper
3217  * bound offset item?
3218  *
3219  * Caller should have verified that upperbound's line pointer is consistent
3220  * using PageGetItemIdCareful() call.
3221  *
3222  * If this function returns false, convention is that caller throws error due
3223  * to corruption.
3224  */
3225 static inline bool
3227  OffsetNumber upperbound)
3228 {
3229  int32 cmp;
3230 
3231  Assert(!key->nextkey && key->backward);
3232 
3233  cmp = _bt_compare(state->rel, key, state->target, upperbound);
3234 
3235  return cmp <= 0;
3236 }
3237 
3238 /*
3239  * Does the invariant hold that the key is strictly greater than a given lower
3240  * bound offset item?
3241  *
3242  * Caller should have verified that lowerbound's line pointer is consistent
3243  * using PageGetItemIdCareful() call.
3244  *
3245  * If this function returns false, convention is that caller throws error due
3246  * to corruption.
3247  */
3248 static inline bool
3250  OffsetNumber lowerbound)
3251 {
3252  int32 cmp;
3253 
3254  Assert(!key->nextkey && key->backward);
3255 
3256  cmp = _bt_compare(state->rel, key, state->target, lowerbound);
3257 
3258  /* pg_upgrade'd indexes may legally have equal sibling tuples */
3259  if (!key->heapkeyspace)
3260  return cmp >= 0;
3261 
3262  /*
3263  * No need to consider the possibility that scankey has attributes that we
3264  * need to force to be interpreted as negative infinity. _bt_compare() is
3265  * able to determine that scankey is greater than negative infinity. The
3266  * distinction between "==" and "<" isn't interesting here, since
3267  * corruption is indicated either way.
3268  */
3269  return cmp > 0;
3270 }
3271 
3272 /*
3273  * Does the invariant hold that the key is strictly less than a given upper
3274  * bound offset item, with the offset relating to a caller-supplied page that
3275  * is not the current target page?
3276  *
3277  * Caller's non-target page is a child page of the target, checked as part of
3278  * checking a property of the target page (i.e. the key comes from the
3279  * target). Verifies line pointer on behalf of caller.
3280  *
3281  * If this function returns false, convention is that caller throws error due
3282  * to corruption.
3283  */
3284 static inline bool
3286  BlockNumber nontargetblock, Page nontarget,
3287  OffsetNumber upperbound)
3288 {
3289  ItemId itemid;
3290  int32 cmp;
3291 
3292  Assert(!key->nextkey && key->backward);
3293 
3294  /* Verify line pointer before checking tuple */
3295  itemid = PageGetItemIdCareful(state, nontargetblock, nontarget,
3296  upperbound);
3297  cmp = _bt_compare(state->rel, key, nontarget, upperbound);
3298 
3299  /* pg_upgrade'd indexes may legally have equal sibling tuples */
3300  if (!key->heapkeyspace)
3301  return cmp <= 0;
3302 
3303  /* See invariant_l_offset() for an explanation of this extra step */
3304  if (cmp == 0)
3305  {
3306  IndexTuple child;
3307  int uppnkeyatts;
3308  ItemPointer childheaptid;
3309  BTPageOpaque copaque;
3310  bool nonpivot;
3311 
3312  child = (IndexTuple) PageGetItem(nontarget, itemid);
3313  copaque = BTPageGetOpaque(nontarget);
3314  nonpivot = P_ISLEAF(copaque) && upperbound >= P_FIRSTDATAKEY(copaque);
3315 
3316  /* Get number of keys + heap TID for child/non-target item */
3317  uppnkeyatts = BTreeTupleGetNKeyAtts(child, state->rel);
3318  childheaptid = BTreeTupleGetHeapTIDCareful(state, child, nonpivot);
3319 
3320  /* Heap TID is tiebreaker key attribute */
3321  if (key->keysz == uppnkeyatts)
3322  return key->scantid == NULL && childheaptid != NULL;
3323 
3324  return key->keysz < uppnkeyatts;
3325  }
3326 
3327  return cmp < 0;
3328 }
3329 
3330 /*
3331  * Given a block number of a B-Tree page, return page in palloc()'d memory.
3332  * While at it, perform some basic checks of the page.
3333  *
3334  * There is never an attempt to get a consistent view of multiple pages using
3335  * multiple concurrent buffer locks; in general, we only acquire a single pin
3336  * and buffer lock at a time, which is often all that the nbtree code requires.
3337  * (Actually, bt_recheck_sibling_links couples buffer locks, which is the only
3338  * exception to this general rule.)
3339  *
3340  * Operating on a copy of the page is useful because it prevents control
3341  * getting stuck in an uninterruptible state when an underlying operator class
3342  * misbehaves.
3343  */
3344 static Page
3346 {
3347  Buffer buffer;
3348  Page page;
3349  BTPageOpaque opaque;
3350  OffsetNumber maxoffset;
3351 
3352  page = palloc(BLCKSZ);
3353 
3354  /*
3355  * We copy the page into local storage to avoid holding pin on the buffer
3356  * longer than we must.
3357  */
3358  buffer = ReadBufferExtended(state->rel, MAIN_FORKNUM, blocknum, RBM_NORMAL,
3359  state->checkstrategy);
3360  LockBuffer(buffer, BT_READ);
3361 
3362  /*
3363  * Perform the same basic sanity checking that nbtree itself performs for
3364  * every page:
3365  */
3366  _bt_checkpage(state->rel, buffer);
3367 
3368  /* Only use copy of page in palloc()'d memory */
3369  memcpy(page, BufferGetPage(buffer), BLCKSZ);
3370  UnlockReleaseBuffer(buffer);
3371 
3372  opaque = BTPageGetOpaque(page);
3373 
3374  if (P_ISMETA(opaque) && blocknum != BTREE_METAPAGE)
3375  ereport(ERROR,
3376  (errcode(ERRCODE_INDEX_CORRUPTED),
3377  errmsg("invalid meta page found at block %u in index \"%s\"",
3378  blocknum, RelationGetRelationName(state->rel))));
3379 
3380  /* Check page from block that ought to be meta page */
3381  if (blocknum == BTREE_METAPAGE)
3382  {
3383  BTMetaPageData *metad = BTPageGetMeta(page);
3384 
3385  if (!P_ISMETA(opaque) ||
3386  metad->btm_magic != BTREE_MAGIC)
3387  ereport(ERROR,
3388  (errcode(ERRCODE_INDEX_CORRUPTED),
3389  errmsg("index \"%s\" meta page is corrupt",
3390  RelationGetRelationName(state->rel))));
3391 
3392  if (metad->btm_version < BTREE_MIN_VERSION ||
3393  metad->btm_version > BTREE_VERSION)
3394  ereport(ERROR,
3395  (errcode(ERRCODE_INDEX_CORRUPTED),
3396  errmsg("version mismatch in index \"%s\": file version %d, "
3397  "current version %d, minimum supported version %d",
3399  metad->btm_version, BTREE_VERSION,
3400  BTREE_MIN_VERSION)));
3401 
3402  /* Finished with metapage checks */
3403  return page;
3404  }
3405 
3406  /*
3407  * Deleted pages that still use the old 32-bit XID representation have no
3408  * sane "level" field because they type pun the field, but all other pages
3409  * (including pages deleted on Postgres 14+) have a valid value.
3410  */
3411  if (!P_ISDELETED(opaque) || P_HAS_FULLXID(opaque))
3412  {
3413  /* Okay, no reason not to trust btpo_level field from page */
3414 
3415  if (P_ISLEAF(opaque) && opaque->btpo_level != 0)
3416  ereport(ERROR,
3417  (errcode(ERRCODE_INDEX_CORRUPTED),
3418  errmsg_internal("invalid leaf page level %u for block %u in index \"%s\"",
3419  opaque->btpo_level, blocknum,
3420  RelationGetRelationName(state->rel))));
3421 
3422  if (!P_ISLEAF(opaque) && opaque->btpo_level == 0)
3423  ereport(ERROR,
3424  (errcode(ERRCODE_INDEX_CORRUPTED),
3425  errmsg_internal("invalid internal page level 0 for block %u in index \"%s\"",
3426  blocknum,
3427  RelationGetRelationName(state->rel))));
3428  }
3429 
3430  /*
3431  * Sanity checks for number of items on page.
3432  *
3433  * As noted at the beginning of _bt_binsrch(), an internal page must have
3434  * children, since there must always be a negative infinity downlink
3435  * (there may also be a highkey). In the case of non-rightmost leaf
3436  * pages, there must be at least a highkey. The exceptions are deleted
3437  * pages, which contain no items.
3438  *
3439  * This is correct when pages are half-dead, since internal pages are
3440  * never half-dead, and leaf pages must have a high key when half-dead
3441  * (the rightmost page can never be deleted). It's also correct with
3442  * fully deleted pages: _bt_unlink_halfdead_page() doesn't change anything
3443  * about the target page other than setting the page as fully dead, and
3444  * setting its xact field. In particular, it doesn't change the sibling
3445  * links in the deletion target itself, since they're required when index
3446  * scans land on the deletion target, and then need to move right (or need
3447  * to move left, in the case of backward index scans).
3448  */
3449  maxoffset = PageGetMaxOffsetNumber(page);
3450  if (maxoffset > MaxIndexTuplesPerPage)
3451  ereport(ERROR,
3452  (errcode(ERRCODE_INDEX_CORRUPTED),
3453  errmsg("Number of items on block %u of index \"%s\" exceeds MaxIndexTuplesPerPage (%u)",
3454  blocknum, RelationGetRelationName(state->rel),
3456 
3457  if (!P_ISLEAF(opaque) && !P_ISDELETED(opaque) && maxoffset < P_FIRSTDATAKEY(opaque))
3458  ereport(ERROR,
3459  (errcode(ERRCODE_INDEX_CORRUPTED),
3460  errmsg("internal block %u in index \"%s\" lacks high key and/or at least one downlink",
3461  blocknum, RelationGetRelationName(state->rel))));
3462 
3463  if (P_ISLEAF(opaque) && !P_ISDELETED(opaque) && !P_RIGHTMOST(opaque) && maxoffset < P_HIKEY)
3464  ereport(ERROR,
3465  (errcode(ERRCODE_INDEX_CORRUPTED),
3466  errmsg("non-rightmost leaf block %u in index \"%s\" lacks high key item",
3467  blocknum, RelationGetRelationName(state->rel))));
3468 
3469  /*
3470  * In general, internal pages are never marked half-dead, except on
3471  * versions of Postgres prior to 9.4, where it can be valid transient
3472  * state. This state is nonetheless treated as corruption by VACUUM on
3473  * from version 9.4 on, so do the same here. See _bt_pagedel() for full
3474  * details.
3475  */
3476  if (!P_ISLEAF(opaque) && P_ISHALFDEAD(opaque))
3477  ereport(ERROR,
3478  (errcode(ERRCODE_INDEX_CORRUPTED),
3479  errmsg("internal page block %u in index \"%s\" is half-dead",
3480  blocknum, RelationGetRelationName(state->rel)),
3481  errhint("This can be caused by an interrupted VACUUM in version 9.3 or older, before upgrade. Please REINDEX it.")));
3482 
3483  /*
3484  * Check that internal pages have no garbage items, and that no page has
3485  * an invalid combination of deletion-related page level flags
3486  */
3487  if (!P_ISLEAF(opaque) && P_HAS_GARBAGE(opaque))
3488  ereport(ERROR,
3489  (errcode(ERRCODE_INDEX_CORRUPTED),
3490  errmsg_internal("internal page block %u in index \"%s\" has garbage items",
3491  blocknum, RelationGetRelationName(state->rel))));
3492 
3493  if (P_HAS_FULLXID(opaque) && !P_ISDELETED(opaque))
3494  ereport(ERROR,
3495  (errcode(ERRCODE_INDEX_CORRUPTED),
3496  errmsg_internal("full transaction id page flag appears in non-deleted block %u in index \"%s\"",
3497  blocknum, RelationGetRelationName(state->rel))));
3498 
3499  if (P_ISDELETED(opaque) && P_ISHALFDEAD(opaque))
3500  ereport(ERROR,
3501  (errcode(ERRCODE_INDEX_CORRUPTED),
3502  errmsg_internal("deleted page block %u in index \"%s\" is half-dead",
3503  blocknum, RelationGetRelationName(state->rel))));
3504 
3505  return page;
3506 }
3507 
3508 /*
3509  * _bt_mkscankey() wrapper that automatically prevents insertion scankey from
3510  * being considered greater than the pivot tuple that its values originated
3511  * from (or some other identical pivot tuple) in the common case where there
3512  * are truncated/minus infinity attributes. Without this extra step, there
3513  * are forms of corruption that amcheck could theoretically fail to report.
3514  *
3515  * For example, invariant_g_offset() might miss a cross-page invariant failure
3516  * on an internal level if the scankey built from the first item on the
3517  * target's right sibling page happened to be equal to (not greater than) the
3518  * last item on target page. The !backward tiebreaker in _bt_compare() might
3519  * otherwise cause amcheck to assume (rather than actually verify) that the
3520  * scankey is greater.
3521  */
3522 static inline BTScanInsert
3524 {
3525  BTScanInsert skey;
3526 
3527  skey = _bt_mkscankey(rel, itup);
3528  skey->backward = true;
3529 
3530  return skey;
3531 }
3532 
3533 /*
3534  * PageGetItemId() wrapper that validates returned line pointer.
3535  *
3536  * Buffer page/page item access macros generally trust that line pointers are
3537  * not corrupt, which might cause problems for verification itself. For
3538  * example, there is no bounds checking in PageGetItem(). Passing it a
3539  * corrupt line pointer can cause it to return a tuple/pointer that is unsafe
3540  * to dereference.
3541  *
3542  * Validating line pointers before tuples avoids undefined behavior and
3543  * assertion failures with corrupt indexes, making the verification process
3544  * more robust and predictable.
3545  */
3546 static ItemId
3548  OffsetNumber offset)
3549 {
3550  ItemId itemid = PageGetItemId(page, offset);
3551 
3552  if (ItemIdGetOffset(itemid) + ItemIdGetLength(itemid) >
3553  BLCKSZ - MAXALIGN(sizeof(BTPageOpaqueData)))
3554  ereport(ERROR,
3555  (errcode(ERRCODE_INDEX_CORRUPTED),
3556  errmsg("line pointer points past end of tuple space in index \"%s\"",
3558  errdetail_internal("Index tid=(%u,%u) lp_off=%u, lp_len=%u lp_flags=%u.",
3559  block, offset, ItemIdGetOffset(itemid),
3560  ItemIdGetLength(itemid),
3561  ItemIdGetFlags(itemid))));
3562 
3563  /*
3564  * Verify that line pointer isn't LP_REDIRECT or LP_UNUSED, since nbtree
3565  * never uses either. Verify that line pointer has storage, too, since
3566  * even LP_DEAD items should within nbtree.
3567  */
3568  if (ItemIdIsRedirected(itemid) || !ItemIdIsUsed(itemid) ||
3569  ItemIdGetLength(itemid) == 0)
3570  ereport(ERROR,
3571  (errcode(ERRCODE_INDEX_CORRUPTED),
3572  errmsg("invalid line pointer storage in index \"%s\"",
3574  errdetail_internal("Index tid=(%u,%u) lp_off=%u, lp_len=%u lp_flags=%u.",
3575  block, offset, ItemIdGetOffset(itemid),
3576  ItemIdGetLength(itemid),
3577  ItemIdGetFlags(itemid))));
3578 
3579  return itemid;
3580 }
3581 
3582 /*
3583  * BTreeTupleGetHeapTID() wrapper that enforces that a heap TID is present in
3584  * cases where that is mandatory (i.e. for non-pivot tuples)
3585  */
3586 static inline ItemPointer
3588  bool nonpivot)
3589 {
3590  ItemPointer htid;
3591 
3592  /*
3593  * Caller determines whether this is supposed to be a pivot or non-pivot
3594  * tuple using page type and item offset number. Verify that tuple
3595  * metadata agrees with this.
3596  */
3597  Assert(state->heapkeyspace);
3598  if (BTreeTupleIsPivot(itup) && nonpivot)
3599  ereport(ERROR,
3600  (errcode(ERRCODE_INDEX_CORRUPTED),
3601  errmsg_internal("block %u or its right sibling block or child block in index \"%s\" has unexpected pivot tuple",
3602  state->targetblock,
3603  RelationGetRelationName(state->rel))));
3604 
3605  if (!BTreeTupleIsPivot(itup) && !nonpivot)
3606  ereport(ERROR,
3607  (errcode(ERRCODE_INDEX_CORRUPTED),
3608  errmsg_internal("block %u or its right sibling block or child block in index \"%s\" has unexpected non-pivot tuple",
3609  state->targetblock,
3610  RelationGetRelationName(state->rel))));
3611 
3612  htid = BTreeTupleGetHeapTID(itup);
3613  if (!ItemPointerIsValid(htid) && nonpivot)
3614  ereport(ERROR,
3615  (errcode(ERRCODE_INDEX_CORRUPTED),
3616  errmsg("block %u or its right sibling block or child block in index \"%s\" contains non-pivot tuple that lacks a heap TID",
3617  state->targetblock,
3618  RelationGetRelationName(state->rel))));
3619 
3620  return htid;
3621 }
3622 
3623 /*
3624  * Return the "pointed to" TID for itup, which is used to generate a
3625  * descriptive error message. itup must be a "data item" tuple (it wouldn't
3626  * make much sense to call here with a high key tuple, since there won't be a
3627  * valid downlink/block number to display).
3628  *
3629  * Returns either a heap TID (which will be the first heap TID in posting list
3630  * if itup is posting list tuple), or a TID that contains downlink block
3631  * number, plus some encoded metadata (e.g., the number of attributes present
3632  * in itup).
3633  */
3634 static inline ItemPointer
3636 {
3637  /*
3638  * Rely on the assumption that !heapkeyspace internal page data items will
3639  * correctly return TID with downlink here -- BTreeTupleGetHeapTID() won't
3640  * recognize it as a pivot tuple, but everything still works out because
3641  * the t_tid field is still returned
3642  */
3643  if (!BTreeTupleIsPivot(itup))
3644  return BTreeTupleGetHeapTID(itup);
3645 
3646  /* Pivot tuple returns TID with downlink block (heapkeyspace variant) */
3647  return &itup->t_tid;
3648 }
uint32 BlockNumber
Definition: block.h:31
#define InvalidBlockNumber
Definition: block.h:33
static bool BlockNumberIsValid(BlockNumber blockNumber)
Definition: block.h:71
void bloom_free(bloom_filter *filter)
Definition: bloomfilter.c:126
bloom_filter * bloom_create(int64 total_elems, int bloom_work_mem, uint64 seed)
Definition: bloomfilter.c:87
double bloom_prop_bits_set(bloom_filter *filter)
Definition: bloomfilter.c:187
bool bloom_lacks_element(bloom_filter *filter, unsigned char *elem, size_t len)
Definition: bloomfilter.c:157
void bloom_add_element(bloom_filter *filter, unsigned char *elem, size_t len)
Definition: bloomfilter.c:135
static Datum values[MAXATTR]
Definition: bootstrap.c:152
int Buffer
Definition: buf.h:23
#define InvalidBuffer
Definition: buf.h:25
void UnlockReleaseBuffer(Buffer buffer)
Definition: bufmgr.c:4577
void LockBuffer(Buffer buffer, int mode)
Definition: bufmgr.c:4795
Buffer ReadBufferExtended(Relation reln, ForkNumber forkNum, BlockNumber blockNum, ReadBufferMode mode, BufferAccessStrategy strategy)
Definition: bufmgr.c:781
@ BAS_BULKREAD
Definition: bufmgr.h:35
#define RelationGetNumberOfBlocks(reln)
Definition: bufmgr.h:229
static Page BufferGetPage(Buffer buffer)
Definition: bufmgr.h:350
@ RBM_NORMAL
Definition: bufmgr.h:44
static bool BufferIsValid(Buffer bufnum)
Definition: bufmgr.h:301
Pointer Page
Definition: bufpage.h:78
static Item PageGetItem(Page page, ItemId itemId)
Definition: bufpage.h:351
static ItemId PageGetItemId(Page page, OffsetNumber offsetNumber)
Definition: bufpage.h:240
static XLogRecPtr PageGetLSN(Page page)
Definition: bufpage.h:383
static OffsetNumber PageGetMaxOffsetNumber(Page page)
Definition: bufpage.h:369
unsigned int uint32
Definition: c.h:493
#define MAXALIGN(LEN)
Definition: c.h:798
signed int int32
Definition: c.h:481
#define Max(x, y)
Definition: c.h:985
#define INT64_FORMAT
Definition: c.h:535
#define OidIsValid(objectId)
Definition: c.h:762
int errmsg_internal(const char *fmt,...)
Definition: elog.c:1159
int errdetail_internal(const char *fmt,...)
Definition: elog.c:1232
int errdetail(const char *fmt,...)
Definition: elog.c:1205
int errhint(const char *fmt,...)
Definition: elog.c:1319
int errcode(int sqlerrcode)
Definition: elog.c:859
int errmsg(const char *fmt,...)
Definition: elog.c:1072
#define DEBUG2
Definition: elog.h:29
#define DEBUG1
Definition: elog.h:30
#define ERROR
Definition: elog.h:39
#define elog(elevel,...)
Definition: elog.h:224
#define ereport(elevel,...)
Definition: elog.h:149
void ExecDropSingleTupleTableSlot(TupleTableSlot *slot)
Definition: execTuples.c:1253
#define PG_RETURN_VOID()
Definition: fmgr.h:349
#define PG_GETARG_OID(n)
Definition: fmgr.h:275
#define PG_NARGS()
Definition: fmgr.h:203
#define PG_DETOAST_DATUM(datum)
Definition: fmgr.h:240
#define PG_GETARG_BOOL(n)
Definition: fmgr.h:274
#define PG_FUNCTION_ARGS
Definition: fmgr.h:193
BufferAccessStrategy GetAccessStrategy(BufferAccessStrategyType btype)
Definition: freelist.c:541
int maintenance_work_mem
Definition: globals.c:130
int NewGUCNestLevel(void)
Definition: guc.c:2237
void RestrictSearchPath(void)
Definition: guc.c:2248
void AtEOXact_GUC(bool isCommit, int nestLevel)
Definition: guc.c:2264
#define HeapTupleHeaderGetXmin(tup)
Definition: htup_details.h:309
Oid IndexGetRelation(Oid indexId, bool missing_ok)
Definition: index.c:3520
IndexInfo * BuildIndexInfo(Relation index)
Definition: index.c:2407
void index_close(Relation relation, LOCKMODE lockmode)
Definition: indexam.c:177
Relation index_open(Oid relationId, LOCKMODE lockmode)
Definition: indexam.c:133
IndexTuple index_form_tuple(TupleDesc tupleDescriptor, const Datum *values, const bool *isnull)
Definition: indextuple.c:44
int i
Definition: isn.c:73
#define ItemIdGetLength(itemId)
Definition: itemid.h:59
#define ItemIdGetOffset(itemId)
Definition: itemid.h:65
#define ItemIdIsDead(itemId)
Definition: itemid.h:113
#define ItemIdIsUsed(itemId)
Definition: itemid.h:92
#define ItemIdIsRedirected(itemId)
Definition: itemid.h:106
#define ItemIdGetFlags(itemId)
Definition: itemid.h:71
int32 ItemPointerCompare(ItemPointer arg1, ItemPointer arg2)
Definition: itemptr.c:51
static OffsetNumber ItemPointerGetOffsetNumber(const ItemPointerData *pointer)
Definition: itemptr.h:124
static OffsetNumber ItemPointerGetOffsetNumberNoCheck(const ItemPointerData *pointer)
Definition: itemptr.h:114
static BlockNumber ItemPointerGetBlockNumber(const ItemPointerData *pointer)
Definition: itemptr.h:103
static BlockNumber ItemPointerGetBlockNumberNoCheck(const ItemPointerData *pointer)
Definition: itemptr.h:93
static void ItemPointerCopy(const ItemPointerData *fromPointer, ItemPointerData *toPointer)
Definition: itemptr.h:172
static bool ItemPointerIsValid(const ItemPointerData *pointer)
Definition: itemptr.h:83
#define IndexTupleHasVarwidths(itup)
Definition: itup.h:72
IndexTupleData * IndexTuple
Definition: itup.h:53
#define IndexTupleSize(itup)
Definition: itup.h:70
static Datum index_getattr(IndexTuple tup, int attnum, TupleDesc tupleDesc, bool *isnull)
Definition: itup.h:117
#define MaxIndexTuplesPerPage
Definition: itup.h:165
Assert(fmt[strlen(fmt) - 1] !='\n')
int LOCKMODE
Definition: lockdefs.h:26
#define AccessShareLock
Definition: lockdefs.h:36
#define ShareLock
Definition: lockdefs.h:40
void MemoryContextReset(MemoryContext context)
Definition: mcxt.c:371
void pfree(void *pointer)
Definition: mcxt.c:1508
void * palloc0(Size size)
Definition: mcxt.c:1334
MemoryContext CurrentMemoryContext
Definition: mcxt.c:131
void * MemoryContextAlloc(MemoryContext context, Size size)
Definition: mcxt.c:1168
void MemoryContextDelete(MemoryContext context)
Definition: mcxt.c:442
void * palloc(Size size)
Definition: mcxt.c:1304
#define AllocSetContextCreate
Definition: memutils.h:129
#define ALLOCSET_DEFAULT_SIZES
Definition: memutils.h:153
#define SECURITY_RESTRICTED_OPERATION
Definition: miscadmin.h:315
#define CHECK_FOR_INTERRUPTS()
Definition: miscadmin.h:122
void GetUserIdAndSecContext(Oid *userid, int *sec_context)
Definition: miscinit.c:635
void SetUserIdAndSecContext(Oid userid, int sec_context)
Definition: miscinit.c:642
IndexTuple _bt_form_posting(IndexTuple base, ItemPointer htids, int nhtids)
Definition: nbtdedup.c:864
void _bt_relbuf(Relation rel, Buffer buf)
Definition: nbtpage.c:1023
void _bt_checkpage(Relation rel, Buffer buf)
Definition: nbtpage.c:797
void _bt_metaversion(Relation rel, bool *heapkeyspace, bool *allequalimage)
Definition: nbtpage.c:739
#define P_HAS_FULLXID(opaque)
Definition: nbtree.h:228
#define P_ISHALFDEAD(opaque)
Definition: nbtree.h:224
static uint16 BTreeTupleGetNPosting(IndexTuple posting)
Definition: nbtree.h:518
static bool BTreeTupleIsPivot(IndexTuple itup)
Definition: nbtree.h:480
#define BTPageGetMeta(p)
Definition: nbtree.h:121
#define P_ISLEAF(opaque)
Definition: nbtree.h:220
#define BTREE_MIN_VERSION
Definition: nbtree.h:151
#define P_HIKEY
Definition: nbtree.h:367
#define P_HAS_GARBAGE(opaque)
Definition: nbtree.h:226
#define BTMaxItemSizeNoHeapTid(page)
Definition: nbtree.h:169
#define P_ISMETA(opaque)
Definition: nbtree.h:223
#define BTPageGetOpaque(page)
Definition: nbtree.h:73
#define P_ISDELETED(opaque)
Definition: nbtree.h:222
#define BTREE_MAGIC
Definition: nbtree.h:149
#define BTREE_VERSION
Definition: nbtree.h:150
static BlockNumber BTreeTupleGetTopParent(IndexTuple leafhikey)
Definition: nbtree.h:620
#define MaxTIDsPerBTreePage
Definition: nbtree.h:185
#define P_FIRSTDATAKEY(opaque)
Definition: nbtree.h:369
#define P_ISROOT(opaque)
Definition: nbtree.h:221
#define P_NONE
Definition: nbtree.h:212
#define P_RIGHTMOST(opaque)
Definition: nbtree.h:219
#define BTMaxItemSize(page)
Definition: nbtree.h:164
#define P_INCOMPLETE_SPLIT(opaque)
Definition: nbtree.h:227
#define BTREE_METAPAGE
Definition: nbtree.h:148
static ItemPointer BTreeTupleGetPostingN(IndexTuple posting, int n)
Definition: nbtree.h:544
#define BT_READ
Definition: nbtree.h:719
static BlockNumber BTreeTupleGetDownLink(IndexTuple pivot)
Definition: nbtree.h:556
#define P_IGNORE(opaque)
Definition: nbtree.h:225
static ItemPointer BTreeTupleGetMaxHeapTID(IndexTuple itup)
Definition: nbtree.h:664
static bool BTreeTupleIsPosting(IndexTuple itup)
Definition: nbtree.h:492
static ItemPointer BTreeTupleGetHeapTID(IndexTuple itup)
Definition: nbtree.h:638
#define BTreeTupleGetNAtts(itup, rel)
Definition: nbtree.h:577
BTStack _bt_search(Relation rel, Relation heaprel, BTScanInsert key, Buffer *bufP, int access)
Definition: nbtsearch.c:96
OffsetNumber _bt_binsrch_insert(Relation rel, BTInsertState insertstate)
Definition: nbtsearch.c:468
int32 _bt_compare(Relation rel, BTScanInsert key, Page page, OffsetNumber offnum)
Definition: nbtsearch.c:682
void _bt_freestack(BTStack stack)
Definition: nbtutils.c:173
BTScanInsert _bt_mkscankey(Relation rel, IndexTuple itup)
Definition: nbtutils.c:81
bool _bt_check_natts(Relation rel, bool heapkeyspace, Page page, OffsetNumber offnum)
Definition: nbtutils.c:2522
bool _bt_allequalimage(Relation rel, bool debugmessage)
Definition: nbtutils.c:2740
#define InvalidOffsetNumber
Definition: off.h:26
#define OffsetNumberIsValid(offsetNumber)
Definition: off.h:39
#define OffsetNumberNext(offsetNumber)
Definition: off.h:52
uint16 OffsetNumber
Definition: off.h:24
static MemoryContext MemoryContextSwitchTo(MemoryContext context)
Definition: palloc.h:124
FormData_pg_attribute * Form_pg_attribute
Definition: pg_attribute.h:209
#define ERRCODE_DATA_CORRUPTED
Definition: pg_basebackup.c:41
#define INDEX_MAX_KEYS
uint64 pg_prng_uint64(pg_prng_state *state)
Definition: pg_prng.c:134
pg_prng_state pg_global_prng_state
Definition: pg_prng.c:34
#define ERRCODE_T_R_SERIALIZATION_FAILURE
Definition: pgbench.c:76
#define ERRCODE_UNDEFINED_TABLE
Definition: pgbench.c:78
static Datum PointerGetDatum(const void *X)
Definition: postgres.h:322
uintptr_t Datum
Definition: postgres.h:64
static Pointer DatumGetPointer(Datum X)
Definition: postgres.h:312
#define InvalidOid
Definition: postgres_ext.h:36
unsigned int Oid
Definition: postgres_ext.h:31
char * psprintf(const char *fmt,...)
Definition: psprintf.c:46
static int cmp(const chr *x, const chr *y, size_t len)
Definition: regc_locale.c:743
static SMgrRelation RelationGetSmgr(Relation rel)
Definition: rel.h:567
#define RelationGetDescr(relation)
Definition: rel.h:531
#define RelationGetRelationName(relation)
Definition: rel.h:539
#define RELATION_IS_OTHER_TEMP(relation)
Definition: rel.h:658
#define IndexRelationGetNumberOfKeyAttributes(relation)
Definition: rel.h:524
@ MAIN_FORKNUM
Definition: relpath.h:50
bool smgrexists(SMgrRelation reln, ForkNumber forknum)
Definition: smgr.c:398
TransactionId RecentXmin
Definition: snapmgr.c:99
Snapshot GetTransactionSnapshot(void)
Definition: snapmgr.c:216
void UnregisterSnapshot(Snapshot snapshot)
Definition: snapmgr.c:836
Snapshot RegisterSnapshot(Snapshot snapshot)
Definition: snapmgr.c:794
#define SnapshotAny
Definition: snapmgr.h:33
#define InvalidSnapshot
Definition: snapshot.h:123
bool bounds_valid
Definition: nbtree.h:823
IndexTuple itup
Definition: nbtree.h:811
BTScanInsert itup_key
Definition: nbtree.h:813
uint32 btm_level
Definition: nbtree.h:108
BlockNumber btm_fastroot
Definition: nbtree.h:109
uint32 btm_version
Definition: nbtree.h:106
uint32 btm_magic
Definition: nbtree.h:105
BlockNumber btm_root
Definition: nbtree.h:107
uint32 btm_fastlevel
Definition: nbtree.h:110
BlockNumber btpo_next
Definition: nbtree.h:65
BlockNumber btpo_prev
Definition: nbtree.h:64
uint32 btpo_level
Definition: nbtree.h:66
ItemPointer scantid
Definition: nbtree.h:791
bool heapkeyspace
Definition: nbtree.h:786
bool anynullkeys
Definition: nbtree.h:788
BufferAccessStrategy checkstrategy
Definition: verify_nbtree.c:89
Snapshot snapshot
Definition: verify_nbtree.c:95
bloom_filter * filter
BlockNumber targetblock
BlockNumber prevrightlink
XLogRecPtr targetlsn
MemoryContext targetcontext
Definition: verify_nbtree.c:87
IndexTuple lowkey
Relation heaprel
Definition: verify_nbtree.c:75
IndexInfo * indexinfo
Definition: verify_nbtree.c:94
bool istruerootlevel
uint32 level
BlockNumber leftmost
HeapTupleHeader t_data
Definition: htup.h:68
bool ii_Unique
Definition: execnodes.h:197
uint16 * ii_ExclusionStrats
Definition: execnodes.h:193
Oid * ii_ExclusionOps
Definition: execnodes.h:191
bool ii_Concurrent
Definition: execnodes.h:202
Oid * ii_ExclusionProcs
Definition: execnodes.h:192
ItemPointerData t_tid
Definition: itup.h:37
unsigned short t_info
Definition: itup.h:49
OffsetNumber ip_posid
Definition: itemptr.h:39
struct HeapTupleData * rd_indextuple
Definition: rel.h:194
Form_pg_index rd_index
Definition: rel.h:192
Oid * rd_opfamily
Definition: rel.h:207
Form_pg_class rd_rel
Definition: rel.h:111
TransactionId xmin
Definition: snapshot.h:157
Definition: type.h:95
Definition: regguts.h:323
void table_close(Relation relation, LOCKMODE lockmode)
Definition: table.c:126
Relation table_open(Oid relationId, LOCKMODE lockmode)
Definition: table.c:40
TupleTableSlot * table_slot_create(Relation relation, List **reglist)
Definition: tableam.c:91
static TableScanDesc table_beginscan_strat(Relation rel, Snapshot snapshot, int nkeys, struct ScanKeyData *key, bool allow_strat, bool allow_sync)
Definition: tableam.h:925
static double table_index_build_scan(Relation table_rel, Relation index_rel, struct IndexInfo *index_info, bool allow_sync, bool progress, IndexBuildCallback callback, void *callback_state, TableScanDesc scan)
Definition: tableam.h:1767
static bool table_tuple_fetch_row_version(Relation rel, ItemPointer tid, Snapshot snapshot, TupleTableSlot *slot)
Definition: tableam.h:1278
bool TransactionIdPrecedes(TransactionId id1, TransactionId id2)
Definition: transam.c:280
#define TransactionIdIsValid(xid)
Definition: transam.h:41
#define TupleDescAttr(tupdesc, i)
Definition: tupdesc.h:92
#define VARATT_IS_COMPRESSED(PTR)
Definition: varatt.h:288
#define VARATT_IS_EXTERNAL(PTR)
Definition: varatt.h:289
static bool offset_is_negative_infinity(BTPageOpaque opaque, OffsetNumber offset)
static bool bt_leftmost_ignoring_half_dead(BtreeCheckState *state, BlockNumber start, BTPageOpaque start_opaque)
static bool invariant_l_offset(BtreeCheckState *state, BTScanInsert key, OffsetNumber upperbound)
static ItemPointer BTreeTupleGetPointsToTID(IndexTuple itup)
struct BtreeCheckState BtreeCheckState
static IndexTuple bt_posting_plain_tuple(IndexTuple itup, int n)
static void bt_target_page_check(BtreeCheckState *state)
static void bt_check_every_level(Relation rel, Relation heaprel, bool heapkeyspace, bool readonly, bool heapallindexed, bool rootdescend, bool checkunique)
static void bt_entry_unique_check(BtreeCheckState *state, IndexTuple itup, BlockNumber targetblock, OffsetNumber offset, int *lVis_i, ItemPointer *lVis_tid, OffsetNumber *lVis_offset, BlockNumber *lVis_block)
PG_MODULE_MAGIC
Definition: verify_nbtree.c:46
static bool bt_pivot_tuple_identical(bool heapkeyspace, IndexTuple itup1, IndexTuple itup2)
static void bt_report_duplicate(BtreeCheckState *state, ItemPointer tid, BlockNumber block, OffsetNumber offset, int posting, ItemPointer nexttid, BlockNumber nblock, OffsetNumber noffset, int nposting)
static void bt_index_check_internal(Oid indrelid, bool parentcheck, bool heapallindexed, bool rootdescend, bool checkunique)
static bool invariant_leq_offset(BtreeCheckState *state, BTScanInsert key, OffsetNumber upperbound)
Datum bt_index_parent_check(PG_FUNCTION_ARGS)
static void bt_child_highkey_check(BtreeCheckState *state, OffsetNumber target_downlinkoffnum, Page loaded_child, uint32 target_level)
static bool heap_entry_is_visible(BtreeCheckState *state, ItemPointer tid)
static BTScanInsert bt_mkscankey_pivotsearch(Relation rel, IndexTuple itup)
Datum bt_index_check(PG_FUNCTION_ARGS)
static BtreeLevel bt_check_level_from_leftmost(BtreeCheckState *state, BtreeLevel level)
static void bt_downlink_missing_check(BtreeCheckState *state, bool rightsplit, BlockNumber blkno, Page page)
PG_FUNCTION_INFO_V1(bt_index_check)
static ItemId PageGetItemIdCareful(BtreeCheckState *state, BlockNumber block, Page page, OffsetNumber offset)
static void bt_tuple_present_callback(Relation index, ItemPointer tid, Datum *values, bool *isnull, bool tupleIsAlive, void *checkstate)
static bool btree_index_mainfork_expected(Relation rel)
static bool bt_rootdescend(BtreeCheckState *state, IndexTuple itup)
static BTScanInsert bt_right_page_check_scankey(BtreeCheckState *state, OffsetNumber *rightfirstoffset)
static bool invariant_g_offset(BtreeCheckState *state, BTScanInsert key, OffsetNumber lowerbound)
#define InvalidBtreeLevel
Definition: verify_nbtree.c:52
static Page palloc_btree_page(BtreeCheckState *state, BlockNumber blocknum)
static IndexTuple bt_normalize_tuple(BtreeCheckState *state, IndexTuple itup)
static void bt_recheck_sibling_links(BtreeCheckState *state, BlockNumber btpo_prev_from_target, BlockNumber leftcurrent)
static ItemPointer BTreeTupleGetHeapTIDCareful(BtreeCheckState *state, IndexTuple itup, bool nonpivot)
#define BTreeTupleGetNKeyAtts(itup, rel)
Definition: verify_nbtree.c:53
static void bt_child_check(BtreeCheckState *state, BTScanInsert targetkey, OffsetNumber downlinkoffnum)
static void btree_index_checkable(Relation rel)
static bool invariant_l_nontarget_offset(BtreeCheckState *state, BTScanInsert key, BlockNumber nontargetblock, Page nontarget, OffsetNumber upperbound)
struct BtreeLevel BtreeLevel
#define IsolationUsesXactSnapshot()
Definition: xact.h:51
bool RecoveryInProgress(void)
Definition: xlog.c:6201
#define LSN_FORMAT_ARGS(lsn)
Definition: xlogdefs.h:43
uint64 XLogRecPtr
Definition: xlogdefs.h:21