1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
#!/bin/env tclsh
package require sha256
package require sqlite3
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]
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} {
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} {
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"
if {[string length $Fbench] < ([string length $bench] * 95 / 100)} {
puts -nonewline $fd "F"
zlib push deflate $fd -level 9
} else { puts -nonewline $fd "r" }
puts -nonewline $fd $data
close $fd
}
proc writestore {store data} {
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
}
return $hash
}