Posted to tcl by dbohdan at Tue May 04 15:07:54 GMT 2021view raw

  1. #! /usr/bin/env tclsh
  2.  
  3. package require Tcl 8.7
  4.  
  5.  
  6. namespace eval ::pkgfs {
  7. variable carts {
  8. tcllib-1.20 QmRjsBWcu4W78F19vkXeBgwY5m8fpD2A6SHeSCCsAnHh5B
  9. }
  10. variable debug true
  11. variable version 0.1.0
  12. }
  13.  
  14. namespace eval ::pkgfs::http {
  15. variable client {}
  16. }
  17.  
  18. namespace eval ::pkgfs::ipfs {
  19. variable cacheDir [file normalize ~/.cache/pkgfs/]
  20. variable currentGateway 0
  21. variable gateways {
  22. https://cloudflare-ipfs.com/ipfs/%s
  23. https://ipfs.io/ipfs/%s
  24. }
  25. }
  26.  
  27.  
  28. try {
  29. package require http
  30. package require tls
  31.  
  32. http::register https 443 [list ::tls::socket -autoservername true]
  33.  
  34. set ::pkgfs::http::client tcl-http
  35. } on error e {
  36. try {
  37. exec curl --version
  38. set ::pkgfs::http::client curl-cli
  39. } on error _ {
  40. error {no usable HTTPS client}
  41. }
  42. }
  43.  
  44.  
  45. proc ::pkgfs::grab {cart {tries 3}} {
  46. variable carts
  47.  
  48. set pluggedIn false
  49. debug Grabbing cart $cart
  50.  
  51. for {set i 1} {$i <= $tries} {incr i} {
  52. debug Attempt number $i
  53.  
  54. try {
  55. set f [ipfs::cache [dict get $carts $cart]]
  56. debug Cart $cart is in $f
  57. plug-in $f
  58. } trap {PKGFS HTTP DOWNLOAD} e {
  59. debug HTTP client error: $e
  60. } trap {TCL ZIPFS} e {
  61. debug zipfs error: $e
  62. file delete $f
  63. } on ok _ {
  64. set pluggedIn true
  65. break
  66. }
  67. }
  68.  
  69. if {!$pluggedIn} {
  70. return \
  71. -code error \
  72. -errorcode {PKGFS GRAB} \
  73. [list failed to download and plug in cart $cart] \
  74. }
  75.  
  76. debug Plugged in $f
  77. }
  78.  
  79.  
  80. proc ::pkgfs::debug args {
  81. variable debug
  82.  
  83. if {!$debug} return
  84. set caller [dict get [info frame -1] proc]
  85. puts stderr [format {PKGFS %-25s %s} $caller $args]
  86. }
  87.  
  88.  
  89. proc ::pkgfs::plug-in zip {
  90. set new [index-dirs [mount $zip]]
  91. lappend ::auto_path {*}$new
  92.  
  93. return $new
  94. }
  95.  
  96.  
  97. proc ::pkgfs::mount zip {
  98. set root [zipfs root]
  99. set dest $root[file rootname [file tail $zip]]
  100.  
  101. zipfs mount $dest $zip
  102.  
  103. return $dest
  104. }
  105.  
  106.  
  107. proc ::pkgfs::index-dirs path {
  108. lmap f [zipfs list -glob $path*] {
  109. if {[file tail $f] ne {pkgIndex.tcl}} continue
  110. file dirname $f
  111. }
  112. }
  113.  
  114.  
  115. proc ::pkgfs::ipfs::cache src {
  116. variable cacheDir
  117.  
  118. file mkdir $cacheDir
  119. set dest [file join $cacheDir $src]
  120.  
  121. if {[file exists $dest]} {
  122. ::pkgfs::debug Destination exists
  123. return $dest
  124. }
  125.  
  126. ::pkgfs::debug Downloading...
  127. download $src $dest
  128.  
  129. return $dest
  130. }
  131.  
  132.  
  133. proc ::pkgfs::ipfs::download {src dest} {
  134. variable currentGateway
  135. variable gateways
  136.  
  137. set gateway [lindex $gateways $currentGateway]
  138. set currentGateway [expr { ($currentGateway + 1) % [llength $gateways] }]
  139. ::pkgfs::debug Chose gateway $gateway
  140. ::pkgfs::http::download [format $gateway $src] $dest
  141. }
  142.  
  143.  
  144. proc ::pkgfs::http::download {url dest} {
  145. variable client
  146.  
  147. try {
  148. $client $url $dest
  149. } on error {e opts} {
  150. dict set opts -errorcode {PKGFS HTTP DOWNLOAD}
  151. return -code error {*}$opts $e
  152. }
  153. }
  154.  
  155.  
  156. proc ::pkgfs::http::curl-cli {url dest} {
  157. exec curl --fail --location --output $dest --silent $url
  158. }
  159.  
  160.  
  161. proc ::pkgfs::http::tcl-http {src dest} {
  162. try {
  163. set token [http::get $url]
  164. set data [http::data $token]
  165.  
  166. set ch [open $dest wb]
  167. puts -nonewline $ch $data
  168. } finally {
  169. catch { http::cleanup $token }
  170. catch { close $ch }
  171. }
  172. }
  173.  
  174.  
  175. pkgfs::grab tcllib-1.20
  176. puts [package require aes]
  177. puts [package require picoirc]
  178.  
  179.  
  180. package provide pkgfs 0