Posted to tcl by dbohdan at Wed May 05 06:35:00 GMT 2021view raw

  1. #! /usr/bin/env tclsh
  2. # Copyright (c) 2021 D. Bohdan and contributors.
  3. # License: MIT.
  4. # ==============================================================================
  5. # Permission is hereby granted, free of charge, to any person obtaining a copy
  6. # of this software and associated documentation files (the "Software"), to deal
  7. # in the Software without restriction, including without limitation the rights
  8. # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  9. # copies of the Software, and to permit persons to whom the Software is
  10. # furnished to do so, subject to the following conditions:
  11. #
  12. # The above copyright notice and this permission notice shall be included in
  13. # all copies or substantial portions of the Software.
  14. #
  15. # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  16. # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  17. # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  18. # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  19. # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  20. # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  21. # THE SOFTWARE.
  22. # ==============================================================================
  23.  
  24. package require Tcl 8.7
  25.  
  26.  
  27. namespace eval ::pkgfs {
  28. variable available {
  29. {core tcllib 1.20+}
  30. {
  31. ref
  32. QmRjsBWcu4W78F19vkXeBgwY5m8fpD2A6SHeSCCsAnHh5B
  33.  
  34. checksum
  35. 92479b4e7beb8e2682dac733fd5399252f00fe2219d5532d9065aeb634360c49
  36.  
  37. algo
  38. sha256
  39. }
  40.  
  41. {dbohdan autoopts 0.6.1}
  42. {
  43. ref
  44. Qmea9ksHVd8sGTDuREX3jvgeymggnkE3eaWUkXEnS6Y5cH
  45.  
  46. checksum
  47. 0102ef871955d26ba17c42d0ec4fcb0e32f67c4b5f1a7b12880456dba199c095
  48.  
  49. algo
  50. sha256
  51. }
  52.  
  53. {dbohdan jimlib 0.15.0}
  54. {
  55. ref
  56. QmSoxa3WhHdDUHQo7JjD4DVn5sUM9sxfDUrSQbhdBNuipQ
  57.  
  58. checksum
  59. b413d8938818c4b100b968096a45a0686465bdd53392480a5bdb89ff11fb8329
  60.  
  61. algo
  62. sha256
  63. }
  64.  
  65. {de tdom 0.9.1 x86_64-linux-gnu}
  66. {
  67. ref
  68. QmcC3T579hjjVb88VnM6DzTgSTbNNoqtSdvKzasRfTvCzP
  69.  
  70. checksum
  71. fbea1a7654b667047fbee42ae5a96d3bc4c4213f0a692dea9120cf102d5887d4
  72.  
  73. algo
  74. sha256
  75. }
  76.  
  77. {drh wapp 1.0.0}
  78. {
  79. ref
  80. QmUSNZqcQZUunP9gRn2kibz4TqAw1WAzXpdPizBFfQDFEq
  81.  
  82. checksum
  83. 86bbb01571ff21db275593d5366febd67fd47635b2c1db6085ef2db257b05c3f
  84.  
  85. algo
  86. sha256
  87. }
  88.  
  89. {mpcjanssen fcgi.tcl 0.5}
  90. {
  91. ref
  92. QmeiVCPoBvk9KMU85vKkoAZWekFWggjAp2iAYPkQQpkqi7
  93.  
  94. checksum
  95. 8dd51684a42b489e53b5636280f435fa8161b1a6c51dec766fe87273a85d4a1d
  96.  
  97. algo
  98. sha256
  99. }
  100. }
  101. variable debug [dict getdef [array get ::env] PKGFS_DEBUG false]
  102. variable version 0.2.0
  103. }
  104.  
  105. namespace eval ::pkgfs::checksum {
  106. variable command
  107. set command(sha256) {}
  108. }
  109.  
  110. namespace eval ::pkgfs::http {
  111. variable client {}
  112. variable timeout 60
  113. }
  114.  
  115. namespace eval ::pkgfs::ipfs {
  116. variable cacheDir [file normalize ~/.cache/pkgfs/]
  117. variable currentGateway 0
  118. variable gateways {
  119. https://cloudflare-ipfs.com/ipfs/%s
  120. https://ipfs.io/ipfs/%s
  121. }
  122. }
  123.  
  124.  
  125. proc ::pkgfs::configure {} {
  126. detect {
  127. package require http
  128. package require tls
  129.  
  130. http::register https 443 [list ::tls::socket -autoservername true]
  131.  
  132. set ::pkgfs::http::client tcl-http
  133. } {
  134. exec curl --version
  135. set ::pkgfs::http::client curl-cli
  136. } {
  137. try {
  138. exec busybox wget
  139. } on error e {
  140. if {![string match *--continue* $e]} {
  141. error {can't execure busybox wget}
  142. }
  143. }
  144.  
  145. set ::pkgfs::http::client busybox-wget
  146. } {
  147. error {no usable HTTPS client}
  148. }
  149.  
  150. detect {
  151. exec sha256sum << {}
  152. set ::pkgfs::checksum::command(sha256sum) sha256sum
  153. } {
  154. exec busybox sha256sum << {}
  155. set ::pkgfs::checksum::command(sha256sum) {busybox sha256sum}
  156. } {
  157. error {no usable sha256sum}
  158. }
  159. }
  160.  
  161.  
  162. proc ::pkgfs::detect args {
  163. set errorScript [lindex $args end]
  164. set args [lrange $args 0 end-1]
  165. set ok false
  166.  
  167. foreach script $args {
  168. try {
  169. uplevel 1 $script
  170. } on ok _ {
  171. set ok true
  172. break
  173. } on error _ {}
  174. }
  175.  
  176. if {!$ok} {
  177. uplevel 1 $errorScript
  178. }
  179. }
  180.  
  181. proc ::pkgfs::grab-all {carts {tries 3}} {
  182. foreach cart $carts {
  183. grab $cart $tries
  184. }
  185. }
  186.  
  187.  
  188. proc ::pkgfs::grab {cart {tries 3}} {
  189. set pluggedIn false
  190. lassign [name-to-ref $cart] metadata fullName
  191. debug Grabbing cart $cart
  192. debug Full name is $fullName
  193. debug Ref is [dict get $metadata ref]
  194.  
  195. for {set i 1} {$i <= $tries} {incr i} {
  196. debug Attempt number $i
  197.  
  198. try {
  199. set f [ipfs::cache [dict get $metadata ref]]
  200. debug Cart is in $f
  201. plug-in $f
  202. } trap {PKGFS HTTP DOWNLOAD} e {
  203. debug HTTP client error: $e
  204. } trap {TCL ZIPFS} e {
  205. debug zipfs error: $e
  206. file delete $f
  207. } on ok _ {
  208. set pluggedIn true
  209. break
  210. }
  211. }
  212.  
  213. if {!$pluggedIn} {
  214. return \
  215. -code error \
  216. -errorcode {PKGFS GRAB} \
  217. [list failed to download and plug in cart $cart] \
  218. }
  219.  
  220. debug inb4
  221. set algo [dict get $metadata algo]
  222. set actual [checksum::$algo $f]
  223. debug done
  224. set expected [dict get $metadata checksum]
  225. if {$actual ne $expected} {
  226. return \
  227. -code error \
  228. -errorcode {PKGFS GRAB} \
  229. [list wrong $algo checksum $actual for cart $cart]
  230. }
  231.  
  232. debug Plugged in $f
  233. }
  234.  
  235.  
  236. proc ::pkgfs::debug args {
  237. variable debug
  238.  
  239. if {!$debug} return
  240. set caller [dict get [info frame -1] proc]
  241. puts stderr [format {PKGFS %-25s %s} $caller $args]
  242. }
  243.  
  244.  
  245. proc ::pkgfs::name-to-ref cart {
  246. variable available
  247.  
  248. set len [llength $cart]
  249.  
  250. foreach k [dict keys $available] {
  251. if {[lrange $k 0 $len-1] eq $cart} {
  252. return [list [dict get $available $k] $k]
  253. }
  254. }
  255.  
  256. error [list unknown cart: $cart]
  257. }
  258.  
  259.  
  260. proc ::pkgfs::plug-in zip {
  261. set new [index-dirs [mount $zip]]
  262. lappend ::auto_path {*}$new
  263.  
  264. return $new
  265. }
  266.  
  267.  
  268. proc ::pkgfs::mount zip {
  269. set root [zipfs root]
  270. set dest $root[file rootname [file tail $zip]]
  271.  
  272. zipfs mount $dest $zip
  273.  
  274. return $dest
  275. }
  276.  
  277.  
  278. proc ::pkgfs::index-dirs path {
  279. lmap f [zipfs list -glob $path*] {
  280. if {[file tail $f] ne {pkgIndex.tcl}} continue
  281. file dirname $f
  282. }
  283. }
  284.  
  285.  
  286. proc ::pkgfs::checksum::sha256 path {
  287. variable command
  288.  
  289. lindex [exec {*}$command(sha256sum) $path] 0
  290. }
  291.  
  292.  
  293. proc ::pkgfs::ipfs::cache src {
  294. variable cacheDir
  295.  
  296. file mkdir $cacheDir
  297. set dest [file join $cacheDir $src]
  298.  
  299. if {[file exists $dest]} {
  300. ::pkgfs::debug Destination exists
  301. return $dest
  302. }
  303.  
  304. ::pkgfs::debug Downloading
  305. download $src $dest
  306.  
  307. return $dest
  308. }
  309.  
  310.  
  311. proc ::pkgfs::ipfs::download {src dest} {
  312. variable currentGateway
  313. variable gateways
  314.  
  315. set gateway [lindex $gateways $currentGateway]
  316. set currentGateway [expr { ($currentGateway + 1) % [llength $gateways] }]
  317. ::pkgfs::debug Chose gateway $gateway
  318. ::pkgfs::http::download [format $gateway $src] $dest
  319. }
  320.  
  321.  
  322. proc ::pkgfs::http::download {url dest} {
  323. variable client
  324.  
  325. try {
  326. ::pkgfs::debug Download client: $client
  327. $client $url $dest
  328. } on error {e opts} {
  329. dict set opts -errorcode {PKGFS HTTP DOWNLOAD}
  330. return -code error {*}$opts $e
  331. }
  332. }
  333.  
  334.  
  335. proc ::pkgfs::http::busybox-wget {url dest} {
  336. variable timeout
  337.  
  338. # BusyBox wget never checks certificates.
  339. exec busybox wget \
  340. --no-check-certificate \
  341. -O $dest \
  342. -q \
  343. $url \
  344. }
  345.  
  346.  
  347. proc ::pkgfs::http::curl-cli {url dest} {
  348. variable timeout
  349.  
  350. exec curl \
  351. --fail \
  352. --location \
  353. --max-time $timeout \
  354. --output $dest \
  355. --silent \
  356. $url \
  357. }
  358.  
  359.  
  360. proc ::pkgfs::http::tcl-http {src dest} {
  361. variable timeout
  362.  
  363. try {
  364. set token [http::get $url -timeout ${timeout}000
  365. set data [http::data $token]
  366.  
  367. set ch [open $dest wb]
  368. puts -nonewline $ch $data
  369. } finally {
  370. catch { http::cleanup $token }
  371. catch { close $ch }
  372. }
  373. }
  374.  
  375.  
  376. ::pkgfs::configure
  377.  
  378. package provide pkgfs 0