~aleteoryx/tclircc

ref: 851ef95148ffda051500d10bc613dda5165faedb tclircc/src/plugins.tcl -rw-r--r-- 10.5 KiB
851ef951Aleteoryx move spdx gen a month ago
                                                                                
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
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
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
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
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
#***
# [manpage_begin plugins tclircc 0.0.1]
# [titledesc {Component plugins.tcl}]
# [description]

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} {

  }
}

#***
# [manpage_end]