#!/bin/env tclsh
package require sqlite3
package require Thread
set init {
package require sha256
proc readbak {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]
read $fd 8; # skip filesize
switch -- $mode {
r {}
F {
zlib push inflate $fd -level 9
}
default {
close $fd
return -code error "unknown compression mode: $mode"
}
}
set ret [read $fd]
close $fd
return $ret
}
proc readstore {store hash {hex 0}} {
set hexhash $hash
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 [readbak $path]
} else {
return -code error "missing file"
}
}
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]
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"
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 {hex 0}} {
set hash [::sha2::sha256 -bin -- $data]
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]/"
file mkdir $path
set path "$path/[string range $hexhash 6 end]"
if {![file exists $path]} {
writebak $path $data
}
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}} {
set hexhash $hash
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
dict replace [statbak $path] path $path
}
}
eval $init
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"
puts stderr " print hash - prints the contents of <hash> on stdout"
puts stderr " stat hash - prints metadata about <hash>"
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\"." }
set fd [open /proc/cpuinfo r]
set nproc [llength [regexp -all -lineanchor -inline "^processor" [read $fd]]]
close $fd
set pool [tpool::create -maxworkers $nproc -initcmd [concat $init "; " [list set arpath $arpath]]]
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 joblist {}
set filelist {}
if {$fd != "stdin"} { close $fd }
foreach filename $files {
if {![file exists $filename]} {
puts stderr "warning: \"$filename\" doesn't exist"
continue
}
set script [concat [list set filename $filename] "; " {
set fd [open $filename rb]
set data [read $fd]
close $fd
set hash [writestore $arpath $data 1]
return [list [string trimleft $filename "/"] $hash]
}]
lappend joblist [tpool::post $pool $script]
}
foreach job $joblist {
tpool::wait $pool $job
append filelist " [tpool::get $pool $job]"
}
set filelist [lsort -stride 2 $filelist]
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 with hash $ref"
}
print {
if {[llength $argv] != 1} usage
set stat [statstore $arpath [lindex $argv 0] 1]
if {$stat == {}} { die "unknown hash" }
puts [readstore $arpath [lindex $argv 0] 1]
}
stat {
if {[llength $argv] != 1} usage
set stat [statstore $arpath [lindex $argv 0] 1]
if {$stat == {}} { die "unknown hash" }
puts "file [lindex $argv 0]:"
puts " version: [dict get $stat ver]"
puts " compression: [dict get $stat mode]"
if {[dict get $stat mode] != "raw"} {
puts " compressed size (bytes): [dict get $stat disksize]"
}
puts " data size (bytes): [dict get $stat datasize]"
}
default usage
}