package require sha256
# plugin manifest format:
# tcl script that must set the following variables at a minimum:
# - name: string
# - slug: string
# must match /^[-_a-zA-Z0-9]+$/
# - namespace: string
# must match /^[-_a-zA-Z0-9]+$/
# - version: string[]
# ordered like {1} > {0}, {0 1} < {1 0}. {1 1} > {1}
# may set:
# - description: string
# - author: string[]
# should contain a list of names with optional website or email, e.g.
# {{Aleteoryx <https://aleteoryx.me>}
# {Alice P Hacker <aph@example.com>}}
# - license: string
# may begin with spdx: to indicate an spdx id or file: to indicate
# a file path relative to the plugin root. .. and root references are
# stripped. if neither prefix applies, assumed to be literal license
# text.
namespace eval plugins {
variable plugins
variable log [logger::init tclircc::plugins]
# generate the script to exfiltrate data from the manifest
variable mf_required {
name 1
namespace {[regexp {^[_a-zA-Z0-9-]+$} $val]}
slug {[regexp {^[_a-zA-Z0-9-]+$} $val]}
version {$val != ""} }
variable mf_optional {
description 1
authors 1
license 1 }
variable mf_procs {
}
variable manifest_reader {
set manifest_dict {}
}
foreach {key check} $mf_required {
set chunk {
if {[info exists %key]} {
set val [set %key]
if %check {
dict set manifest_dict %key [set %key]
} else { return -code error "invalid value for %key: $val" }
} else { return -code error "missing key in manifest: %key" }
}
regsub -all "%key" $chunk [list $key] chunk
regsub -all "%check" $chunk [list $check] chunk
append manifest_reader $chunk
}
foreach {key check} $mf_optional {
set chunk {
if {[info exists %key]} {
set val [set %key]
if %check {
dict set manifest_dict %key [set %key]
}
}
}
regsub -all "%key" $chunk [list $key] chunk
regsub -all "%check" $chunk [list $check] chunk
append manifest_reader $chunk
}
foreach {key _} $mf_procs {
set chunk {
if {%key in [info procs %key]} {
dict set manifest_dict procs %key [list [info args %key] [info body %key]]
}
}
regsub -all "%key" $chunk [list $key] chunk
append manifest_reader $chunk
}
append manifest_reader { set manifest_dict }
# generation done
proc vercmp {v1 v2} {
# normalize the lists, check for equality
if {[list {*}$v1] == [list {*}$v2]} { return 0 }
# compare every element
for {set n 0} {$n < min([llength $v1], [llength $v2])} {incr n} {
if [set cmp [string compare [lindex $v1 $n] [lindex $v2 $n]]] {
return $cmp
}
}
# they can't be equal, so the longer one must be the newer one
if {[llength $v1] > [llength $v2]} { return 1 }
return -1
}
proc enroll_interp {tid iid} {}
proc load {dir {skip_prompt 0}} {
variable log
variable manifest_reader
${log}::info "attempting to load plugin from \"$dir\"..."
set mf_path [file join $dir manifest.tcl]
if {!([file isfile $mf_path] && [file readable $mf_path])} {
${log}::error "couldn't load plugin: manifest \"$mf_path\" not present or not readable!"
return 0
}
set mf_fd [open $mf_path]
set manifest [read $mf_fd]
close $mf_fd
interp create -safe mf_exec
# prevent escapes
interp hide mf_exec package
interp hide mf_exec interp
# prevent hanging the thread
interp hide mf_exec vwait
interp hide mf_exec after
interp hide mf_exec update
interp hide mf_exec gets
interp hide mf_exec read
# this is more than enough for any reasonable manifest
interp limit mf_exec time -seconds [expr {[clock seconds] + 2}]
interp limit mf_exec command -value 10000
# untrusted code time
${log}::debug "evaluating manifest..."
set untrusted_result [catch {
set mf_result [catch { interp eval mf_exec $manifest } result opts]
if {$mf_result != 0} {
${log}::error "couldn't load plugin: manifest return code $mf_result: $result"
return 0
}
set mf_valid [catch { interp eval mf_exec $manifest_reader } result opts]
if {$mf_valid != 0} {
${log}::error "couldn't validate plugin: $result"
return 0
}
# hooray, we have the manifest!
set manifest $result
interp delete mf_exec
} result opts]
switch -- $untrusted_result {
0 { } 2 { return -code 2 result }
1 {
${log}::error "couldn't load plugin: $result"
return 0
}
default {
${log}::alert "unexpected return code from plugin handling: $untrusted_result"
${log}::alert "return options: $opts"
${log}::alert "THIS MAY INDICATE A PLUGIN SANDBOX COMPROMISE!"
return 0
}
}
set pl_name [dict get $manifest name]
set pl_namespace [dict get $manifest namespace]
set pl_slug [dict get $manifest slug]
set pl_version [dict get $manifest version]
set pl_qslug "${pl_namespace}::${pl_slug}"
set pl_verstr "v[join $pl_version .]"
# qualified slug
dict set manifest qslug $pl_qslug
dict set manifest verstr $pl_verstr
${log}::debug "manifest loaded: $pl_name (${pl_qslug}) $pl_verstr"
set stored [core_db eval {
SELECT manifest_hash, version, trusted_until FROM plugins
WHERE slug = $pl_slug
AND namespace = $pl_namespace}]
# load_license manifest
if ![llength $stored] {
tailcall int_load_new $skip_prompt $manifest $dir
} else {
lassign $stored st_mf_hash st_version st_trusted_till
switch -- [vercmp $pl_version $st_version] {
0 { tailcall int_load_existing $manifest $dir $mf_path $st_mf_hash $st_trusted_till }
1 { tailcall int_load_updated $skip_prompt $manifest $dir $st_version $st_trusted_till }
-1 { tailcall int_load_old $manifest $dir $st_version }
}
}
}
proc int_load_new {skip_prompt manifest dir} {
variable log
${log}::info "installing new plugin [dict get $manifest qslug]"
if {!$skip_prompt} {
set manifest [list $manifest]
set dir [list $dir]
t::exec tclircc::ui {
set manifest %manifest
tk_messageBox -type yesno \
-title "Plugin Installation" \
-icon "question" \
-message "Do you want to install \"[dict get $manifest name]\"?" \
-detail [string cat \
"[dict get $manifest qslug] [dict get $manifest verstr]" \
"\nBy [join [dict get $manifest authors] ,]." \
"\n\n[dict get $manifest license]" ]
} {
set manifest %manifest
switch -- $result {
yes {
::plugins::install $manifest %dir
}
no {
set log %log
${log}::info "user cancelled installation of plugin [dict get $manifest qslug]"
}
}
}
} else {
install $manifest $dir
}
}
proc int_load_existing {manifest dir mf_path mf_hash trusted_till} {
variable log
${log}::debug "loading existing plugin [dict get $manifest qslug]"
if {$trusted_till >= [clock seconds]} {
install $manifest $dir
} elseif {[sha2::sha256 -file $mf_path] == $mf_hash} {
install $manifest $dir
} else {
${log}::warn "plugin may have been tampered with!"
set manifest [list $manifest]
set dir [list $dir]
t::exec tclircc::ui {
set manifest %manifest
tk_messageBox -type yesno \
-title "Plugin Tampering Detected!" \
-icon "warning" \
-message "\"[dict get $manifest name]\" ([dict get $manifest qslug]) has been edited since last load!" \
-detail [string cat \
"This may indicate a security compromise, do you want to continue loading it?" \
" (If you are doing plugin development, set the \"Trusted Until\" option!)"]
} {
set manifest %manifest
set log %log
switch -- $result {
yes {
${log}::warn "loading [dict get $manifest qslug] despite potential tampering!"
::plugins::install $manifest %dir
}
no {
${log}::info "not loading [dict get $manifest qslug] due to tampering"
}
}
}
}
}
proc int_load_updated {skip_prompt manifest dir version trusted_till} {
variable log
${log}::info "updating plugin [dict get $manifest qslug] (v[join $version .] -> [dict get $manifest verstr])"
if {!$skip_prompt && [clock seconds] > $trusted_till} {
set manifest [list $manifest]
set dir [list $dir]
t::exec tclircc::ui {
set manifest %manifest
tk_messageBox -type yesno \
-title "Plugin Update" \
-icon "question" \
-message "Do you want to update \"[dict get $manifest name]\"?" \
-detail [string cat \
"[dict get $manifest qslug] [dict get $manifest verstr]" \
"\nBy [join [dict get $manifest authors] ,]." \
"\n\n[dict get $manifest license]" ]
} {
set manifest %manifest
switch -- $result {
yes {
::plugins::install $manifest %dir
}
no {
set log %log
${log}::info "user cancelled update of plugin [dict get $manifest qslug]"
}
}
}
} else {
install $manifest $dir
}
}
proc int_load_old {manifest dir version} {
variable log
${log}::warn "attempting to load older version of [dict get $manifest qslug] (v[join $version .] -> [dict get $manifest verstr])"
set verstr [list "v[join $version .]"]
set manifest [list $manifest]
set dir [list $dir]
t::exec tclircc::ui {
set manifest %manifest
tk_messageBox -type yesno \
-title "Plugin Downgrade!" \
-icon "warning" \
-message [string cat \
"Are you sure you want to downgrade \"[dict get $manifest name]" \
"\" ([dict get $manifest qslug])? A database backup will be made." ] \
-detail [string cat \
"Last saw " %verstr ", attempting to load [dict get $manifest verstr]."]
} {
set manifest %manifest
set log %log
switch -- $result {
yes {
${log}::warn "downgrading [dict get $manifest qslug]! making a backup!"
t::exec tclircc::db backup {
::plugins::install $manifest %dir
}
}
no {
${log}::info "not downgrading [dict get $manifest qslug]"
}
}
}
}
proc install {manifest dir} {
}
}