• 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.

 #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]

 #!/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)

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References