1
2
3
4
5
6
7
8
9
10
11
12
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
|
+
+
-
+
+
+
+
+
|
#! /usr/bin/env tclsh
package require http 2.7
package require sqlite3
if {[catch {
package require sha1
package require sha1
}]} {
@@SHA1.TCL@@
package require sha1
}
namespace eval ::appfs {
variable cachedir "/tmp/appfs-cache"
variable ttl 3600
variable nttl 60
proc _hash_sep {hash {seps 4}} {
|
| ︙ | | |
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
|
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
|
-
-
+
+
+
+
+
-
-
+
+
-
-
-
+
+
+
-
-
-
-
-
-
+
+
+
+
+
+
-
+
-
-
-
-
-
+
+
+
+
+
-
-
-
-
+
+
+
+
-
|
set filekey [_hash_sep $filekey]
}
set file [file join $::appfs::cachedir $filekey]
file mkdir [file dirname $file]
if {![file exists $file]} {
set tmpfile "${file}.new"
if {[file exists $file]} {
return $file
}
set tmpfile "${file}.[expr {rand()}]"
set fd [open $tmpfile "w"]
fconfigure $fd -translation binary
catch {
set token [::http::geturl $url -channel $fd -binary true]
}
if {[info exists token]} {
set ncode [::http::ncode $token]
::http::reset $token
} else {
set ncode "900"
}
close $fd
if {$keyIsHash} {
set hash [string tolower [sha1::sha1 -hex -file $tmpfile]]
} else {
set hash $key
}
if {$ncode == "200" && $hash == $key} {
file rename -force -- $tmpfile $file
} else {
file delete -force -- $tmpfile
}
|
| ︙ | | |
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
+
+
+
+
+
+
|
switch -- $os {
"linux" - "freebsd" - "openbsd" - "netbsd" {
return $os
}
"sunos" {
return "solaris"
}
"noarch" - "none" - "any" - "all" {
return "noarch"
}
}
return -code error "Unable to normalize OS: $os"
}
proc _normalizeCPU {cpu} {
set cpu [string tolower [string trim $cpu]]
switch -glob -- $cpu {
"i?86" {
return "ix86"
}
"x86_64" {
return $cpu
}
"noarch" - "none" - "any" - "all" {
return "noarch"
}
}
return -code error "Unable to normalize CPU: $cpu"
}
proc init {} {
|
| ︙ | | |
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
-
+
|
}
proc download {hostname hash {method sha1}} {
set url "http://$hostname/appfs/$method/$hash"
set file [_cachefile $url $hash]
if {![file exists $file]} {
return -code error "Unable to fetch"
return -code error "Unable to fetch (file does not exist: $file)"
}
return $file
}
proc getindex {hostname} {
set now [clock seconds]
|
| ︙ | | |
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
|
-
+
|
catch {
set token [::http::geturl $url]
if {[::http::ncode $token] == "200"} {
set indexhash_data [::http::data $token]
}
::http::reset $token
$token cleanup
::http::cleanup $token
}
if {![info exists indexhash_data]} {
# Cache this result for 60 seconds
_db eval {INSERT OR REPLACE INTO sites (hostname, lastUpdate, ttl) VALUES ($hostname, $now, $::appfs::nttl);}
return -code error "Unable to fetch $url"
|
| ︙ | | |
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
|
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
|
if {$line == ""} {
continue
}
set work [split $line ","]
unset -nocomplain pkgInfo
if {[catch {
set pkgInfo(package) [lindex $work 0]
set pkgInfo(version) [lindex $work 1]
set pkgInfo(os) [_normalizeOS [lindex $work 2]]
set pkgInfo(cpuArch) [_normalizeCPU [lindex $work 3]]
set pkgInfo(hash) [string tolower [lindex $work 4]]
set pkgInfo(hash_type) "sha1"
set pkgInfo(isLatest) [expr {!![lindex $work 5]}]
set pkgInfo(package) [lindex $work 0]
set pkgInfo(version) [lindex $work 1]
set pkgInfo(os) [_normalizeOS [lindex $work 2]]
set pkgInfo(cpuArch) [_normalizeCPU [lindex $work 3]]
set pkgInfo(hash) [string tolower [lindex $work 4]]
set pkgInfo(hash_type) "sha1"
set pkgInfo(isLatest) [expr {!![lindex $work 5]}]
}]} {
continue
}
if {![_isHash $pkgInfo(hash)]} {
continue
}
lappend curr_packages $pkgInfo(hash)
|
| ︙ | | |