Differences From
Artifact [07f0ced01b]:
1 1 #! /usr/bin/env tclsh
2 2
3 3 package require http 2.7
4 4 package require sqlite3
5 5
6 6 namespace eval ::appfs {
7 - variable sites [list]
8 7 variable cachedir "/tmp/appfs-cache"
9 8
10 9 proc _hash_sep {hash {seps 4}} {
11 10 for {set idx 0} {$idx < $seps} {incr idx} {
12 11 append retval "[string range $hash [expr {$idx * 2}] [expr {($idx * 2) + 1}]]/"
13 12 }
14 13 append retval "[string range $hash [expr {$idx * 2}] end]"
................................................................................
40 39 } else {
41 40 file delete -force -- $tmpfile
42 41 }
43 42 }
44 43
45 44 return $file
46 45 }
46 +
47 + proc _db {args} {
48 + return [uplevel 1 [list ::appfs::db {*}$args]]
49 + }
50 +
51 + proc init {} {
52 + if {[info exists ::appfs::init_called]} {
53 + return
54 + }
55 +
56 + set ::appfs::init_called 1
57 +
58 + if {![info exists ::appfs::db]} {
59 + file mkdir $::appfs::cachedir
60 +
61 + sqlite3 ::appfs::db [file join $::appfs::cachedir cache.db]
62 + }
63 +
64 + _db eval {CREATE TABLE IF NOT EXISTS packages(hostname, sha1, package, version, os, cpuArch, isLatest);}
65 + _db eval {CREATE TABLE IF NOT EXISTS files(package_sha1, type, time, source, size, file_sha1, file_name, file_directory);}
66 + }
47 67
48 68 proc getindex {hostname} {
49 69 if {[string match "*\[/~\]*" $hostname]} {
50 70 return -code error "Invalid hostname"
51 71 }
52 72
53 73 set url "http://$hostname/appfs/index"
................................................................................
96 116 }
97 117
98 118 if {![regexp {^[0-9a-f]*$} $pkgInfo(hash)]} {
99 119 continue
100 120 }
101 121
102 122 set packages($pkgInfo(package)) [array get pkgInfo]
123 +
124 + # Do not do any additional work if we already have this package
125 + set existing_packages [_db eval {SELECT package FROM packages WHERE hostname = $hostname AND sha1 = $pkgInfo(hash);}]
126 + if {[lsearch -exact $existing_packages $pkgInfo(package)] != -1} {
127 + continue
128 + }
129 +
130 + if {$pkgInfo(isLatest)} {
131 + _db eval {UPDATE packages SET isLatest = 0 WHERE hostname = $hostname AND package = $pkgInfo($package) AND os = $pkgInfo($package) AND cpuArch = $pkgInfo(cpuArch);}
132 + }
133 +
134 + _db eval {INSERT INTO packages (hostname, sha1, package, version, os, cpuArch, isLatest) VALUES ($hostname, $pkgInfo(hash), $pkgInfo(package), $pkgInfo(version), $pkgInfo(os), $pkgInfo(cpuArch), $pkgInfo(isLatest) );}
135 +
136 + set file [download $hostname $pkgInfo(hash)]
137 + set fd [open $file]
138 + set pkgdata [read $fd]
139 + close $fd
140 +
141 + foreach line [split $pkgdata "\n"] {
142 + set line [string trim $line]
143 +
144 + if {[string match "*/*" $line]} {
145 + continue
146 + }
147 +
148 + if {$line == ""} {
149 + continue
150 + }
151 +
152 + set work [split $line ","]
153 +
154 + unset -nocomplain fileInfo
155 + set fileInfo(type) [lindex $work 0]
156 + set fileInfo(time) [lindex $work 1]
157 + set fileInfo(name) [lindex $work end]
158 +
159 + set fileInfo(name) [split [string trim $fileInfo(name) "/"] "/"]
160 + set fileInfo(directory) [join [lrange $fileInfo(name) 0 end-1] "/"]
161 + set fileInfo(name) [lindex $fileInfo(name) end]
162 +
163 + set work [lrange $work 2 end-1]
164 + switch -- $fileInfo(type) {
165 + "file" {
166 + set fileInfo(size) [lindex $work 0]
167 + set fileInfo(sha1) [lindex $work 1]
168 + }
169 + "symlink" {
170 + set fileInfo(source) [lindex $work 0]
171 + }
172 + }
173 +
174 + _db eval {INSERT INTO files (package_sha1, type, time, source, size, file_sha1, file_name, file_directory) VALUES ($pkgInfo(hash), $fileInfo(type), $fileInfo(time), $fileInfo(source), $fileInfo(size), $fileInfo(sha1), $fileInfo(name), $fileInfo(directory) );}
175 + }
103 176 }
104 177
105 - return [array get packages]
178 + return COMPLETE
106 179 }
107 180
108 181 proc download {hostname hash {method sha1}} {
109 182 set url "http://$hostname/appfs/$method/$hash"
110 183 set file [_cachefile $url $hash]
111 184
112 185 if {![file exists $file]} {
113 186 return -code error "Unable to fetch"
114 187 }
115 188
116 189 return $file
117 190 }
118 191 }