[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-5.tcl:'''
 # Copyright 2006 George Peter Staplin
 # Revision 5
 # May 31, 2006 fixed a DELETED NEW pattern with proc filter.invalid.  
 
 
 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"
 
   switch -- [compare.records $ar $br] {
    -1 {
     #
     # $a_f < $b_f in character value
     # $a_f was deleted
     #
     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 filter.invalid ar_var {
  upvar $ar_var ar
 
  foreach {key value} [array get ar] {
   if {[set a [lsearch -exact $value DELETED]] >= 0 \
     && [lsearch -exact $value NEW] >= 0} {
    
    set value [lreplace $value $a $a]
    set b [lsearch -exact $value NEW]
    set value [lreplace $value $b $b]
 
    if {![llength $value]} {
     unset ar($key)
     continue
    }
    set ar($key) $value
   }
  }
 }
 
 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
 
  filter.invalid ::changes
 
  parray ::changes
 
  return 0
 }
 exit [main $::argc $::argv]
======
----
[schlenk] For a tripwire like tool, which can also check differences between directories see:

======
 #!/bin/sh
 #
 # trip'em a small script to create filesystem reports similar 
 # to tripwire
 #
 # -*- tcl -*- \
 exec tclsh "$0" ${1+"$@"}

 package require fileutil
 package require logger
 package require cmdline
 package require md5 2
 set version 0.3
 set DEBUG 0
 # Options
 set subcmd [list save check]
 set options {
   {database.arg "stolper.dat" \
   {file used to store the hashes and other info}}
   {dir.arg "." \
   {directory to process}}
   {loglevel.arg "info" \
   {loglevel to use \
   (debug,info, notice,warn,error,critical)}}
   {recursive \
   {process subdirectories recusively}}
 }
 set usage " save | check\nOptions:"
 proc optionenFehler {fehler {kopfzeile {}} } {
  global options
  if {![string equal $kopfzeile ""]} {
   puts stderr $kopfzeile
  }
  puts stderr "[info script] save ?optionen?"
  puts stderr "[info script] check ?optionen?"
  puts stderr [::cmdline::usage $options "Options:" ]

  exit $fehler
 }
 if {[llength $argv] > 0} {
   set cmd [lindex $argv 0]
   if {[lsearch -exact $subcmd $cmd] == -1} {
     optionenFehler 1 "Invalid command \"$cmd\"."
   }
   set argv [lrange $argv 1 end]
 } else {
   optionenFehler 2
   exit 2
 }
 # parse options
 if {[catch {::cmdline::getoptions argv $options $usage} opts ]} {
   puts stderr $opts
   exit 1
 }
 
 foreach {option wert} $opts {
   if {$::DEBUG} {puts stdout "Option: $option Value: $wert"}
   switch -glob -- $option {
        da* {
          if {![file exists $wert] && [string equal $cmd check]} {
            puts stderr "Error: database \"$wert\" does not exist."
            exit 3
          }
          set Config(DB) $wert
        }
        di* {
          if {![file isdirectory $wert]} {
            puts stderr "Error: \"$wert\" is not an existing directory."
            exit 4
          }
          set Config(Startverzeichnis) [file normalize $wert]
        }
        logl* {
          if {[lsearch -exact [::logger::levels] $wert]==-1} {
            puts stderr "Error: unknown loglevel \"$wert\" ."
            exit 5
          }
          set Config(Loglevel) $wert
        }
        r* {
          set Config(rekursiv) $wert
        }
        default {}
        }
 }
 unset opts

 set log [::logger::init stolper]
 ${log}::setlevel $Config(Loglevel)

 proc check {log datenbank start rekursiv } {
   if {[catch {open $datenbank} fd]} {
     ${log}::critical "failed to open database file \"$datenbank\""
     exit 5
   }
   set line [gets $fd]
   if {[string compare "# trip'em $::version" $line]} {
      ${log}::critical "file \"$datenbank\" is not \
                        a trip'em $::version database."
      exit 6
   }
   set line [gets $fd]
   set verzeichnis ""
   regexp {# rootdir:\t(.*)} $line -> verzeichnis
   if {[string compare $verzeichnis $start]} {
      ${log}::critical "root dirs are different \
                        database used \"$verzeichnis\"."
      exit 7
   }
   set line [gets $fd]
   set seconds 0
   regexp {# created at:\t([0-9]+)} $line -> seconds
   ${log}::info "created at: [clock format $seconds]"
   set line [gets $fd]
   set dbrekursiv 0
   regexp {# recursive:\t([01])} $line -> dbrekursiv

   ${log}::info "creating file list"
   if {!$rekursiv} {
     set dateien [glob -nocomplain -directory $start *]
   } else {
     set dateien [::fileutil::find $start]
   }

   set maxlen 0
   while {![eof $fd] && [gets $fd line]} {
     if {[llength $line] == 3} { 
           set name [lindex $line 2]
       set dbmtime($name) [lindex $line 0]
       set dbmd5($name) [lindex $line 1]
       if {[string length $name] > $maxlen} {set maxlen [string length $name]}
     } 
   }
   ${log}::notice "[array size dbmtime] files processed"
   close $fd
   set haveChanges 0
   foreach datei [lsort -ascii $dateien] {
     if {![file isfile $datei]} {continue}
     if {[string length $datei] > $maxlen } {set maxlen [string length $datei]}
     set md5change 0
     set mtimechange 0
     set neu 0
     if {[catch {file mtime $datei} mtime]} {
       set mtime no
     }
     set md5 [::md5::md5 -hex -filename $datei]
     if {[info exists dbmtime($datei)]} {
       if {[string compare -nocase $md5 $dbmd5($datei)]} {
         set md5change 1
           }
       if {$mtime != $dbmtime($datei)} {
         set mtimechange 1
       }
       unset dbmtime($datei)
       unset dbmd5($datei)
     } else {
       set neu 1
     }
     if {$mtimechange || $md5change || $neu} {
       incr haveChanges
           puts -nonewline stdout "[format "%-[expr {$maxlen+5}]s" $datei]"
       if {$neu} {
         puts stdout "NEW"
         continue
       }
       if {$mtimechange} {
         puts -nonewline stdout "MTIME "
       }
       if {$md5change} {
         puts -nonewline stdout "MD5 "
       }
       puts stdout ""
     }
   }
   if {[array size dbmtime]} {
     foreach datei [array keys dbmtime] {
       puts stdout "[format "%-[expr {$maxlen+5}]s\tMISSING" $datei]"
       incr haveChanges
         }
   } 
   if {$haveChanges == 0} {
     puts "NO CHANGES"
   } else {
     puts "DETECTED $haveChanges CHANGES"
   }
 }

 proc save {log datenbank start rekursiv } {
   ${log}::info "creating file list"
   if {!$rekursiv} {
     set dateien [glob -nocomplain -directory $start *]
   } else {
     set dateien [::fileutil::find $start]
   }
   ${log}::info "[llength $dateien] files found"

   if {[catch {open $datenbank {CREAT WRONLY}} fd]} {
     ${log}::critical "could not open database file \"$datenbank\""
     exit 5
   }
   ${log}::notice "opened database file \"$datenbank\" ."
   puts $fd "# trip'em $::version"
   puts $fd "# rootdir:\t$start"
   puts $fd "# created at:\t[clock seconds]"
   puts $fd "# recursive:\t$rekursiv"

   foreach datei [lsort -ascii $dateien] {
     if {![file isfile $datei]} {continue}
     if {[catch {file mtime $datei} mtime]} {
       set mtime "no"
     }
     set md5 [::md5::md5 -hex -filename $datei]
     puts $fd [list $mtime $md5 $datei]
     ${log}::info "processed file $datei"
   }
   close $fd
   ${log}::notice "completed database \"$datenbank\" ."
 }

 $cmd $log $Config(DB) $Config(Startverzeichnis) $Config(rekursiv)
======



<<categories>> File