George Peter Staplin May 30, 2006 - This is some code that can be used to create database snapshots of your filesystem structure and statistics. The first tool genfsdb is used to create a database from a tree. The second tool cmpfsdb is used to compare 2 databases. The database comparison output indicates timestamp changes, deletions, and new files or directories.
An example usage would be tracking what has changed after installing some software in Windows or Unix.
My license for the code: Use it (commercial or non-commercial), learn from it, modify it, give me credit in source form, and don't blame me at all for any damage.
genfsdb-4.tcl:
#Copyright 2006 George Peter Staplin
proc generate.file.system.database {db root} {
proc out data "[list puts [set fd [open $db w]]] \$data"
recurse $root
close $fd
}
proc recurse {dir} {
foreach f [lsort -dictionary [glob -nocomplain [file join $dir *]]] {
#puts FILE:$f
if {![file exists $f]} {
#
# The file is a symbolic link that doesn't point to anything.
#
continue
}
file stat $f stats
#
# It's critical that we use list here, because the filename
# may have spaces.
#
out [list $stats(ctime) $stats(mtime) $f]
if {[file isdirectory $f]} {
#
# XXX we could use a trampoline here to eliminate the recursion
# The wiki has an example for such a trampoline by RS.
# XXX in unix we also have the issue of symbolic links.
# We need a circular link test to make this complete.
#
recurse $f
}
}
}
proc main {argc argv} {
if {2 != $argc} {
puts stderr "syntax is: [info script] database filesystem-root"
return 1
}
generate.file.system.database [lindex $argv 0] [lindex $argv 1]
return 0
}
exit [main $::argc $::argv]cmpfsdb-4.tcl: #Copyright 2006 George Peter Staplin
array set ::records {} array set ::changes {}
proc read.records id {
global records
#
# Read 500 chars, unless that would exceed the amount remaining.
#
set amount 500
if {$amount > $records($id,remaining)} {
set amount $records($id,remaining)
}
#
# Concatenate the partial record (if there was one) with the new data.
#
set data [split $records($id,partial)[read $id $amount] \n]#puts DATA:$data
#
#XXX check for [eof $id] just in case the db is changed by another program?
#
#
# Recalculate the remaining data.
#
set records($id,remaining) [expr {$records($id,remaining) - $amount}]
#
# Set the valid records (terminated by \n) in the records array.
#
set records($id,records) [lrange $data 0 [expr {[llength $data] - 2}]]#puts RECORDS:$records($id,records)
# # There may be a partial record at the very end, so save that for use later. # set records($id,partial) [lindex $data end]
#puts PARTIAL:$records($id,partial)
set records($id,offset) [tell $id]
}
proc init.record {id f} {
global records set records($id,file) $f set records($id,fd) $id set records($id,offset) 0 set records($id,size) [file size $f] set records($id,remaining) $records($id,size) set records($id,partial) "" set records($id,records) [list] read.records $id
}
proc compare.records {a b} {
foreach {a_ctime a_mtime a_f} $a break
foreach {b_ctime b_mtime b_f} $b break
global changes
if {$a_f eq $b_f} {
if {$a_ctime != $b_ctime} {
lappend changes($a_f) CTIME
}
if {$a_mtime != $b_mtime} {
lappend changes($a_f) MTIME
}
return 0
} else {
#puts "a_f $a_f"
#puts "b_f $b_f"
return [string compare $a_f $b_f]
}}
proc next.record id {
global records
if {![llength $records($id,records)]} {
#
# We need to attempt to read more records, because the list is empty.
#
if {$records($id,remaining) <= 0} {
#
# This record database has reached the end.
#
return [list]
}
read.records $id
}
set r [lindex $records($id,records) 0]
set records($id,records) [lrange $records($id,records) 1 end]
#puts REC:$r
return $r}
proc compare.databases {a b} {
global records changes
set ar [next.record $a]
set br [next.record $b]
while {[llength $ar] && [llength $br]} {
set a_f [lindex $ar 2]
set b_f [lindex $br 2]
#puts "CMP $a_f $b_f"
#
# Check if the directory tree for the old database has been deleted.
# If it has, then any files within that directory are deleted.
# This is used to prevent a [list NEW DELETED] pattern from showing
# up in the changes.
#
set a_dir [file dirname $a_f]
if {[info exists changes($a_dir)]
&& [lsearch -exact $changes($a_dir) DELETED] >= 0} {
#puts DELETEDA
set ar [next.record $a]
lappend changes($a_f) DELETED
continue
}
switch -- [compare.records $ar $br] {
-1 {
#
# $a_f < $b_f in character value
# $a_f was deleted
#
puts DELETEDB
lappend changes($a_f) DELETED
set ar [next.record $a]
}
0 {
set ar [next.record $a]
set br [next.record $b]
}
1 {
#
# $a_f > $b_f in character value
# Therefore the file $b_f is a new file.
# XXX is this always right? It seems like it should be, because
# the other operations go a record at a time, and the values are pre-sorted.
#
#puts NEW
lappend changes($b_f) NEW
set br [next.record $b]
}
}
}
#puts AR:$ar
#puts BR:$br
#
# One or both of the lists are exhausted now.
# We must see which it is, and then list the files
# remaining as NEW or DELETED.
#
if {![llength $ar]} {
#
# We have a remaining file unhandled by the loop above.
#
if {[llength $br]} {
lappend changes([lindex $br 2]) NEW
}
#
# The files remaining are new in the 2nd database/b.
#
while {[llength [set br [next.record $b]]]} {
lappend changes([lindex $br 2]) NEW
}
}
if {![llength $br]} {
#
# This record wasn't handled by the loop above.
#
if {[llength $ar]} {
lappend changes([lindex $ar 2]) DELETED
}
#
# The files remaining were deleted from the 2nd database/b.
#
while {[llength [set ar [next.record $a]]]} {
lappend changes([lindex $ar 2]) DELETED
}
}}
proc main {argc argv} {
if {2 != $argc} {
puts stderr "syntax is: [info script] database-1 database-2"
return 1
}
foreach {f1 f2} $argv break
set id1 [open $f1 r]
set id2 [open $f2 r]
init.record $id1 $f1
init.record $id2 $f2
compare.databases $id1 $id2
parray ::changes
return 0} exit main $::argc $::argv
Some Category. I'm too lazy to fill this in. Please help. :)