131f051880 2007-11-09 aku: ## -*- tcl -*- 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# ##################### 131f051880 2007-11-09 aku: ## Copyright (c) 2007 Andreas Kupries. 131f051880 2007-11-09 aku: # 131f051880 2007-11-09 aku: # This software is licensed as described in the file LICENSE, which 131f051880 2007-11-09 aku: # you should have received as part of this distribution. 131f051880 2007-11-09 aku: # 131f051880 2007-11-09 aku: # This software consists of voluntary contributions made by many 131f051880 2007-11-09 aku: # individuals. For exact contribution history, see the revision 131f051880 2007-11-09 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# ##################### 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: ## This package holds a number of integrity checks done on the 131f051880 2007-11-09 aku: ## persistent state. This is used by the passes II and IV. 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# ##################### 131f051880 2007-11-09 aku: ## Requirements 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: package require Tcl 8.4 ; # Required runtime. 131f051880 2007-11-09 aku: package require snit ; # OO system. 131f051880 2007-11-09 aku: package require vc::tools::trouble ; # Error reporting. 131f051880 2007-11-09 aku: package require vc::tools::log ; # User feedback. 131f051880 2007-11-09 aku: package require vc::fossil::import::cvs::state ; # State storage. 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# ##################### 131f051880 2007-11-09 aku: ## 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: snit::type ::vc::fossil::import::cvs::integrity { 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# 131f051880 2007-11-09 aku: ## Public API 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: typemethod strict {} { 131f051880 2007-11-09 aku: set n 0 131f051880 2007-11-09 aku: AllButMeta 131f051880 2007-11-09 aku: Meta 131f051880 2007-11-09 aku: return 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: typemethod metarelaxed {} { 131f051880 2007-11-09 aku: set n 0 131f051880 2007-11-09 aku: AllButMeta b679ca3356 2007-11-25 aku: return b679ca3356 2007-11-25 aku: } b679ca3356 2007-11-25 aku: b679ca3356 2007-11-25 aku: typemethod changesets {} { b679ca3356 2007-11-25 aku: set n 0 b679ca3356 2007-11-25 aku: RevisionChangesets b679ca3356 2007-11-25 aku: SymbolChangesets 131f051880 2007-11-09 aku: return 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# 131f051880 2007-11-09 aku: ## Internal methods 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: proc AllButMeta {} { 131f051880 2007-11-09 aku: # This code performs a number of paranoid checks of the 131f051880 2007-11-09 aku: # database, searching for inconsistent cross-references. 131f051880 2007-11-09 aku: log write 4 integrity {Check database consistency} 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: upvar 1 n n ; # Counter for the checks (we print an id before 131f051880 2007-11-09 aku: # the main label). 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # Find all revisions which disagree with their line of 131f051880 2007-11-09 aku: # development about the project they are owned by. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their LODs have to be in the same project} \ 131f051880 2007-11-09 aku: {disagrees with its LOD about owning project} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, file F, symbol S 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.lod = S.sid 131f051880 2007-11-09 aku: AND F.pid != S.pid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions which disgree with their meta data about 131f051880 2007-11-09 aku: # the project they are owned by. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their meta data have to be in the same project} \ 131f051880 2007-11-09 aku: {disagrees with its meta data about owning project} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, file F, meta M 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.mid = M.mid 131f051880 2007-11-09 aku: AND F.pid != M.pid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a primary child which disagrees 131f051880 2007-11-09 aku: # about the file they belong to. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their primary children have to be in the same file} \ 131f051880 2007-11-09 aku: {disagrees with its primary child about the owning file} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision C, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.child IS NOT NULL 131f051880 2007-11-09 aku: AND R.child = C.rid 131f051880 2007-11-09 aku: AND C.fid != R.fid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # Find all revisions with a branch parent symbol whose parent 131f051880 2007-11-09 aku: # disagrees about the file they belong to. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their branch children have to be in the same file} \ 131f051880 2007-11-09 aku: {at the beginning of its branch and its parent disagree about the owning file} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision P, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.bparent IS NOT NULL 131f051880 2007-11-09 aku: AND R.parent = P.rid 131f051880 2007-11-09 aku: AND R.fid != P.fid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a non-NTDB child which disagrees 131f051880 2007-11-09 aku: # about the file they belong to. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their non-NTDB children have to be in the same file} \ 131f051880 2007-11-09 aku: {disagrees with its non-NTDB child about the owning file} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision C, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.dbchild IS NOT NULL 131f051880 2007-11-09 aku: AND R.dbchild = C.rid 131f051880 2007-11-09 aku: AND C.fid != R.fid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions which have a primary child, but the child 131f051880 2007-11-09 aku: # does not have them as parent. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions have to be parents of their primary children} \ 131f051880 2007-11-09 aku: {is not the parent of its primary child} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision C, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.child IS NOT NULL 131f051880 2007-11-09 aku: AND R.child = C.rid 131f051880 2007-11-09 aku: AND C.parent != R.rid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions which have a primrary child, but the 131f051880 2007-11-09 aku: # child has a branch parent symbol making them brach starters. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Primary children of revisions must not start branches} \ 131f051880 2007-11-09 aku: {is parent of a primary child which is the beginning of a branch} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision C, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.child IS NOT NULL 131f051880 2007-11-09 aku: AND R.child = C.rid 131f051880 2007-11-09 aku: AND C.bparent IS NOT NULL 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions without branch parent symbol which have a 131f051880 2007-11-09 aku: # parent, but the parent does not have them as primary child. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions have to be primary children of their parents, if any} \ 131f051880 2007-11-09 aku: {is not the child of its parent} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision P, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.bparent IS NULL 131f051880 2007-11-09 aku: AND R.parent IS NOT NULL 131f051880 2007-11-09 aku: AND R.parent = P.rid 131f051880 2007-11-09 aku: AND P.child != R.rid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a branch parent symbol which do not 131f051880 2007-11-09 aku: # have a parent. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Branch starting revisions have to have a parent} \ 131f051880 2007-11-09 aku: {at the beginning of its branch has no parent} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.bparent IS NOT NULL 131f051880 2007-11-09 aku: AND R.parent IS NULL 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a branch parent symbol whose parent 131f051880 2007-11-09 aku: # has them as primary child. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Branch starting revisions must not be primary children of their parents} \ 131f051880 2007-11-09 aku: {at the beginning of its branch is the primary child of its parent} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision P, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.bparent IS NOT NULL 131f051880 2007-11-09 aku: AND R.parent IS NOT NULL 131f051880 2007-11-09 aku: AND R.parent = P.rid 131f051880 2007-11-09 aku: AND P.child = R.rid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a non-NTDB child which are not on 131f051880 2007-11-09 aku: # the NTDB. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {NTDB to trunk transition has to begin on NTDB} \ 131f051880 2007-11-09 aku: {has a non-NTDB child, yet is not on the NTDB} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.dbchild IS NOT NULL 131f051880 2007-11-09 aku: AND NOT R.isdefault 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a NTDB parent which are on the NTDB. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {NTDB to trunk transition has to end on non-NTDB} \ 131f051880 2007-11-09 aku: {has a NTDB parent, yet is on the NTDB} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.dbparent IS NOT NULL 131f051880 2007-11-09 aku: AND R.isdefault 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a child which disagrees about the 131f051880 2007-11-09 aku: # line of development they belong to. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their primary children have to be in the same LOD} \ 131f051880 2007-11-09 aku: {and its primary child disagree about their LOD} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision C, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.child IS NOT NULL 131f051880 2007-11-09 aku: AND R.child = C.rid 131f051880 2007-11-09 aku: AND C.lod != R.lod 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a non-NTDB child which agrees about 131f051880 2007-11-09 aku: # the line of development they belong to. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {NTDB and trunk revisions have to be in different LODs} \ 131f051880 2007-11-09 aku: {on NTDB and its non-NTDB child wrongly agree about their LOD} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision C, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.dbchild IS NOT NULL 131f051880 2007-11-09 aku: AND R.dbchild = C.rid 131f051880 2007-11-09 aku: AND C.lod = R.lod 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a branch parent symbol which is not 131f051880 2007-11-09 aku: # their LOD. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Branch starting revisions have to have their LOD as branch parent symbol} \ 131f051880 2007-11-09 aku: {at the beginning of its branch does not have the branch symbol as its LOD} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.bparent IS NOT NULL 131f051880 2007-11-09 aku: AND R.lod != R.bparent 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: # Find all revisions with a branch parent symbol whose parent 131f051880 2007-11-09 aku: # is in the same line of development. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their branch children have to be in different LODs} \ 131f051880 2007-11-09 aku: {at the beginning of its branch and its parent wrongly agree about their LOD} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, revision P, file F 131f051880 2007-11-09 aku: WHERE R.fid = F.fid 131f051880 2007-11-09 aku: AND R.bparent IS NOT NULL 131f051880 2007-11-09 aku: AND R.parent = P.rid 131f051880 2007-11-09 aku: AND R.lod = P.lod 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: return 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: proc Meta {} { 131f051880 2007-11-09 aku: # This code performs a number of paranoid checks of the 131f051880 2007-11-09 aku: # database, searching for inconsistent cross-references. 131f051880 2007-11-09 aku: log write 4 integrity {Check database consistency} 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: upvar 1 n n ; # Counter for the checks (we print an id before 131f051880 2007-11-09 aku: # the main label). 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # Find all revisions which disgree with their meta data about 131f051880 2007-11-09 aku: # the branch/line of development they belong to. 131f051880 2007-11-09 aku: Check \ 131f051880 2007-11-09 aku: {Revisions and their meta data have to be in the same LOD} \ 131f051880 2007-11-09 aku: {disagrees with its meta data about owning LOD} { 131f051880 2007-11-09 aku: SELECT F.name, R.rev 131f051880 2007-11-09 aku: FROM revision R, meta M, file F 131f051880 2007-11-09 aku: WHERE R.mid = M.mid 131f051880 2007-11-09 aku: AND R.lod != M.bid 131f051880 2007-11-09 aku: AND R.fid = F.fid 131f051880 2007-11-09 aku: ; 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: return 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: proc Check {header label sql} { 131f051880 2007-11-09 aku: upvar 1 n n 131f051880 2007-11-09 aku: set ok 1 131f051880 2007-11-09 aku: foreach {fname revnr} [state run $sql] { 131f051880 2007-11-09 aku: set ok 0 131f051880 2007-11-09 aku: trouble fatal "$fname <$revnr> $label" 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: log write 5 integrity "\[[format %02d [incr n]]\] [expr {$ok ? "Ok " : "Failed"}] ... $header" 131f051880 2007-11-09 aku: return 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# 131f051880 2007-11-09 aku: ## Configuration 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: pragma -hasinstances no ; # singleton 131f051880 2007-11-09 aku: pragma -hastypeinfo no ; # no introspection 131f051880 2007-11-09 aku: pragma -hastypedestroy no ; # immortal 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: namespace eval ::vc::fossil::import::cvs { 131f051880 2007-11-09 aku: namespace export integrity 131f051880 2007-11-09 aku: namespace eval integrity { 131f051880 2007-11-09 aku: namespace import ::vc::fossil::import::cvs::state 131f051880 2007-11-09 aku: namespace import ::vc::tools::trouble 131f051880 2007-11-09 aku: namespace import ::vc::tools::log 131f051880 2007-11-09 aku: log register integrity 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: } 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: # # ## ### ##### ######## ############# ##################### 131f051880 2007-11-09 aku: ## Ready 131f051880 2007-11-09 aku: 131f051880 2007-11-09 aku: package provide vc::fossil::import::cvs::integrity 1.0 131f051880 2007-11-09 aku: return
File Annotation