1 files changed, 132 insertions(+), 7 deletions(-)

M backupper.tcl

@@ 19,6 19,7 @@ proc readbak {path} {
   }
 
   set mode [read $fd 1]
+  read $fd 8; # skip filesize
   switch -- $mode {
     r {}
     F {


@@ 34,9 35,8 @@ proc readbak {path} {
   close $fd
   return $ret
 }
-
-proc readstore {store hash} {
-  set hexhash [binary encode hex $hash]
+proc readstore {store hash {hex 0}} {
+  if {!$hex} { set hexhash [binary encode hex $hash] }
   set path $store
   append path "/[string range $hexhash 0 1]"
   append path "/[string range $hexhash 2 3]"


@@ 50,6 50,7 @@ proc readstore {store hash} {
 }
 
 proc writebak {path data} {
+  binary scan $data c _
   set bench [string range $data 0 10000000]
   binary scan $bench c _
   set Fbench [zlib deflate $bench 9]


@@ 57,16 58,20 @@ proc writebak {path data} {
   set fd [open $path wb]
   puts -nonewline $fd "AMEBAK\0"
 
+  set compress 0
   if {[string length $Fbench] < ([string length $bench] * 95 / 100)} {
     puts -nonewline $fd "F"
-    zlib push deflate $fd -level 9
+    set compress 1
   } else { puts -nonewline $fd "r" }
 
+  puts -nonewline $fd [binary format W [string length $data]]
+
+  if {$compress} { zlib push deflate $fd -level 9 }
+
   puts -nonewline $fd $data
   close $fd
 }
-
-proc writestore {store data} {
+proc writestore {store data {hex 0}} {
   set hash [::sha2::sha256 -bin -- $data]
   set hexhash [binary encode hex $hash]
   set path $store


@@ 80,6 85,126 @@ proc writestore {store data} {
     writebak $path $data
   }
 
-  return $hash
+  if {$hex} {
+    return $hexhash
+  } else {
+    return $hash
+  }
 }
 
+proc statbak {path} {
+  set fd [open $path rb]
+  set magic [read $fd 6]
+  if {$magic != "AMEBAK"} {
+    close $fd
+    return -code error "invalid magic string: \"$magic\""
+  }
+
+  set ver [read $fd 1]
+  binary scan $ver c ver
+  if {$ver != 0} {
+    close $fd
+    return -code error "archive file too new: $ver (self: 0)"
+  }
+
+  set mode [read $fd 1]
+  switch -- $mode {
+    r { set mode raw }
+    F { set mode deflate }
+    default {
+      close $fd
+      return -code error "unknown compression mode: $mode"
+    }
+  }
+
+  set disksize [file size $path]
+  binary scan [read $fd 8] W datasize
+
+  close $fd
+  return [list ver $ver mode $mode disksize $disksize datasize $datasize]
+}
+proc statstore {store hash {hex 0}} {
+  if {$$hex} { set hexhash [binary encode hex $hash] }
+  set path $store
+  append path "/[string range $hexhash 0 1]"
+  append path "/[string range $hexhash 2 3]"
+  append path "/[string range $hexhash 4 5]/"
+  append path "/[string range $hexhash 6 end]"
+  if {![file exists $path]} return
+
+  statbak $path
+}
+
+proc usage {} {
+  global argv0
+  puts stderr "usage: $argv0 command store ?args ...?"
+  puts stderr "commands:"
+  puts stderr "  init - initialize a store in store"
+  puts stderr "  importlist ?listfile? - if listfile is ommitted, reads stdin"
+  exit -1
+}
+proc die {reason} {
+  global argv0
+  puts stderr "$argv0: fatal: $reason"
+  exit -2
+}
+
+
+if {[llength $argv] < 2} usage
+
+set argv [lassign $argv command store]
+set dbpath "$store/index.db"
+set arpath "$store/archive"
+
+if {$command == "init"} {
+  if {[file exists $dbpath]} { die "won't overwrite \"$dbpath\"." }
+  file mkdir $store
+  file mkdir $arpath
+  sqlite3 db $dbpath
+
+  db eval {
+    CREATE TABLE tarballs (name TEXT NOT NULL, type TEXT NOT NULL, ref TEXT NOT NULL, desc TEXT NOT NULL, date TEXT NOT NULL);
+  }
+  exit
+}
+
+if {[catch {sqlite3 db $dbpath -create false}]} { die "can't find a store at \"$store\"." }
+
+switch -- $command {
+  importlist {
+    if {[llength $argv] > 1} usage
+    if {[llength $argv] == 1} {
+      set fd [open [lindex $argv 0]]
+      set fname [lindex $argv 0]
+    } else {
+      set fd stdin
+      set fname "pipeline"
+    }
+
+    set files [split [string trim [read $fd]] "\n"]
+    set filelist {}
+    close $fd
+
+    foreach filename $files {
+      if {![file exists $filename]} {
+        puts stderr "warning: \"$filename\" doesn't exist"
+        continue
+      }
+
+      set fd [open $filename rb]
+      set data [read $fd]
+      close $fd
+
+      set hash [writestore $arpath $data 1]
+      lappend filelist [string trimleft $filename "/"] $hash
+    }
+
+    set ref [writestore $arpath $filelist 1]
+    set date [clock seconds]
+    set rowid [db eval {
+      INSERT INTO tarballs VALUES ($fname, "list", $ref, "", $date) RETURNING rowid;
+    }]
+
+    puts stderr "inserted as archive $rowid"
+  }
+}