pkgfs prototype (Tcl 8.7)

#! /usr/bin/env tclsh

package require Tcl 8.7


namespace eval ::pkgfs {
    variable carts {
        tcllib-1.20 QmRjsBWcu4W78F19vkXeBgwY5m8fpD2A6SHeSCCsAnHh5B
    }
    variable debug true
    variable version 0.1.0
}

namespace eval ::pkgfs::http {
    variable client {}
}

namespace eval ::pkgfs::ipfs {
    variable cacheDir [file normalize ~/.cache/pkgfs/]
    variable currentGateway 0
    variable gateways {
        https://cloudflare-ipfs.com/ipfs/%s
        https://ipfs.io/ipfs/%s
    }
}


try {
    package require http
    package require tls

    http::register https 443 [list ::tls::socket -autoservername true]

    set ::pkgfs::http::client tcl-http
} on error e {
    try {
        exec curl --version
        set ::pkgfs::http::client curl-cli
    } on error _ {
        error {no usable HTTPS client}
    }
}


proc ::pkgfs::grab {cart {tries 3}} {
    variable carts

    set pluggedIn false
    debug Grabbing cart $cart

    for {set i 1} {$i <= $tries} {incr i} {
        debug Attempt number $i

        try {
            set f [ipfs::cache [dict get $carts $cart]]
            debug Cart $cart is in $f
            plug-in $f
        } trap {PKGFS HTTP DOWNLOAD} e {
            debug HTTP client error: $e
        } trap {TCL ZIPFS} e {
            debug zipfs error: $e
            file delete $f
        } on ok _ {
            set pluggedIn true
            break
        }
    }

    if {!$pluggedIn} {
        return \
            -code error \
            -errorcode {PKGFS GRAB} \
            [list failed to download and plug in cart $cart] \
    }

    debug Plugged in $f
}


proc ::pkgfs::debug args {
    variable debug

    if {!$debug} return
    set caller [dict get [info frame -1] proc]
    puts stderr [format {PKGFS %-25s %s} $caller $args]
}


proc ::pkgfs::plug-in zip {
    set new [index-dirs [mount $zip]]
    lappend ::auto_path {*}$new

    return $new
}


proc ::pkgfs::mount zip {
    set root [zipfs root]
    set dest $root[file rootname [file tail $zip]]

    zipfs mount $dest $zip

    return $dest
}


proc ::pkgfs::index-dirs path {
    lmap f [zipfs list -glob $path*] {
        if {[file tail $f] ne {pkgIndex.tcl}} continue
        file dirname $f
    }
}


proc ::pkgfs::ipfs::cache src {
    variable cacheDir

    file mkdir $cacheDir
    set dest [file join $cacheDir $src]

    if {[file exists $dest]} {
        ::pkgfs::debug Destination exists
        return $dest
    }

    ::pkgfs::debug Downloading...
    download $src $dest

    return $dest
}


proc ::pkgfs::ipfs::download {src dest} {
    variable currentGateway
    variable gateways

    set gateway [lindex $gateways $currentGateway]
    set currentGateway [expr { ($currentGateway + 1) % [llength $gateways] }]
    ::pkgfs::debug Chose gateway $gateway
    ::pkgfs::http::download [format $gateway $src] $dest
}


proc ::pkgfs::http::download {url dest} {
    variable client

    try {
        $client $url $dest
    } on error {e opts} {
        dict set opts -errorcode {PKGFS HTTP DOWNLOAD}
        return -code error {*}$opts $e
    }
}


proc ::pkgfs::http::curl-cli {url dest} {
    exec curl --fail --location --output $dest --silent $url
}


proc ::pkgfs::http::tcl-http {src dest} {
    try {
        set token [http::get $url]
        set data [http::data $token]

        set ch [open $dest wb]
        puts -nonewline $ch $data
    } finally {
        catch { http::cleanup $token }
        catch { close $ch }
    }
}


pkgfs::grab tcllib-1.20
puts [package require aes]
puts [package require picoirc]


package provide pkgfs 0