8 files changed, 260 insertions(+), 41 deletions(-)

R src/{migrate_core.tcl => db.tcl}
A src/db/networks.tcl
M src/deps.tcl
A src/history.tcl
M src/main.tcl
M src/persist.tcl
A src/ui.tcl
A src/util.tcl

@@ 5,55 5,84 @@
 
 # TODO: make this more robust maybe
 
-interp create migrator
-
-migrator eval {
-  lappend migrations 0 {init plugins} {
--- init plugins
-CREATE TABLE plugins (slug TEXT NOT NULL, -- corresponds directly to manifest
-                      namespace TEXT NOT NULL, -- corresponds directly to manifest
-                      version TEXT NOT NULL, -- corresponds directly to manifest
-                      manifest_hash TEXT NOT NULL, -- sha256
-                      trusted_until TEXT NOT NULL, -- ignore manifest changes if loading before timestamp
-                      updated_on TEXT NOT NULL, -- date of last update
-                      priority INTEGER NOT NULL, -- load priority
-                      PRIMARY KEY (slug, namespace));
+namespace eval db {
+  variable log [logger::init tclircc::db]
+  variable logc [logger::init tclircc::db::cleanup]
+  variable autocleanup_dbs {}
+  variable autocleanup_steps {}
+  variable autocleanup_task {}
+}
+
+proc db::cleanup {} {
+  variable autocleanup_dbs
+  variable autocleanup_steps
+  variable logc
+  foreach db $autocleanup_dbs {
+    ${logc}::debug "cleaning up \"$db\"..."
+    if [dict exists $autocleanup_steps $db] {
+      ${logc}::debug "executing additional script on \"$db\"..."
+      $db eval [dict get $autocleanup_steps $db]
+    }
+    $db eval { VACUUM; }
+    ${logc}::debug "cleaned up \"$db\"!"
   }
 }
+proc db::autocleanup {interval} {
+  variable autocleanup_task
+  db::cleanup
+  set autocleanup_task [after $interval [list db::autocleanup $interval]]
+}
 
-migrator alias db core_db
-migrator eval {
-  package require logger
-  package require Tk
-  wm withdraw .
+proc db::init_core {data_dir} {
+  variable autocleanup_dbs
+  sqlite3 core_db [file join $data_dir core.db]
+  lappend autocleanup_dbs core_db
 
-  set log [logger::init tclircc::db::migrate]
+  interp create migrator
 
-  ${log}::debug "starting migrations"
-  if ![db eval {
-    SELECT count(*) FROM sqlite_master WHERE name="_migrations"}] {
-    ${log}::info "initializing core db!"
-    db eval {CREATE TABLE _migrations (id INTEGER PRIMARY KEY, date TEXT)}
+  migrator eval {
+    lappend migrations 0 {init networks} {
+      CREATE TABLE networks (name TEXT NOT NULL,
+                             servers TEXT NOT NULL,
+                             autoconnect BOOL NOT NULL DEFAULT 0,
+                             creds TEXT NOT NULL DEFAULT '');
+    }
   }
 
-  foreach {id name contents} $migrations {
-    # TODO: debug interpolation?
-    if ![db eval "SELECT count(*) FROM _migrations WHERE id=$id"] {
-      ${log}::info "performing migration $id: $name"
-      db eval BEGIN
-      set migrationdate [clock seconds]
-      db eval $contents
-      db eval "INSERT INTO _migrations (id, date) VALUES ($id, $migrationdate)"
-      set last $id
-      db eval COMMIT
-    } elseif [info exists last] {
-      ${log}::warn "completed migrations exist after incomplete migration $last, core database may be corrupted!"
+  migrator alias core_db core_db
+  migrator eval {
+    package require logger
+    package require Tk
+    wm withdraw .
+
+    set log [logger::init tclircc::db::migrate]
+
+    ${log}::debug "starting migrations"
+    if ![core_db eval {
+      SELECT count(*) FROM sqlite_master WHERE name="_migrations"}] {
+      ${log}::info "initializing core db!"
+      core_db eval {CREATE TABLE _migrations (id INTEGER PRIMARY KEY, date TEXT)}
     }
-  }
 
-  ${log}::info "core db migrated!"
+    foreach {id name contents} $migrations {
+      # TODO: debug interpolation?
+      if ![core_db eval "SELECT count(*) FROM _migrations WHERE id=$id"] {
+        ${log}::info "performing migration $id: $name"
+        core_db eval BEGIN
+        set migrationdate [clock seconds]
+        core_db eval $contents
+        core_db eval "INSERT INTO _migrations (id, date) VALUES ($id, $migrationdate)"
+        set last $id
+        core_db eval COMMIT
+      } elseif [info exists last] {
+        ${log}::warn "completed migrations exist after incomplete migration $last, core database may be corrupted!"
+      }
+    }
+
+    ${log}::info "core db migrated!"
+  }
+  interp delete migrator
 }
-interp delete migrator
 
 #***
 # [manpage_end]

@@ 0,0 1,17 @@
+namespace eval db::networks {}
+
+proc db::networks::ls {db} {
+  set ret {}
+  $db eval {SELECT rowid as id, * FROM networks;} network {
+    set ndict {}
+    foreach k $network(*) {
+      dict set ndict $k [set network($k)]
+    }
+    lappend ret $ndict
+  }
+  return $ret
+}
+
+proc db::networks::add {db name servers} {
+  $db eval {INSERT INTO networks VALUES ($name $servers);}
+}

@@ 4,6 4,9 @@ set deps {
   sqlite3 3.47
   tls 1.7
   logger 0.9
+  md5 2.0
+  tcl::chan::random 1.0
+  tcl::randomseed 1.0
 }
 
 set missing {}

@@ 0,0 1,42 @@
+namespace eval hist {
+  variable known_channels
+}
+
+# channel names can't contain spaces
+proc hist::to_tablename {chan} {
+  regsub {\\} $chan { s} chan
+  regsub {"} $chan { q} chan
+  return $chan
+}
+
+proc hist::ensure {db chan} {
+  variable known_channels
+  set chan [hist::to_tablename $chan]
+  if [dict exists [set known_channels($db)] $chan] { return }
+
+  if ![$db exists {SELECT * FROM sqlite_master WHERE type='table' AND name=$chan}] {
+    $db eval "CREATE TABLE \"$chan\" (id TEXT NOT NULL PRIMARY KEY, src TEXT NOT NULL, msg TEXT NOT NULL, ts INTEGER NOT NULL, metadata TEXT NOT NULL);"
+    $db eval "CREATE INDEX \"${chan}_src\" ON \"$chan\" (src);"
+    $db eval "CREATE INDEX \"${chan}_ts\" ON \"$chan\" (ts);"
+  }
+  dict set known_channels($db) $chan {}
+
+  set cleanup_script {}
+  foreach chan [dict keys [set known_channels($db)]] {
+    append cleanup_script "REINDEX \"$chan\"; REINDEX \"${chan}_src\"; REINDEX \"${chan}_ts\"; "
+  }
+
+  dict set ::db::autocleanup_steps $db $cleanup_script
+}
+
+proc hist::put {db chan source message timestamp metadata} {
+  set chan [hist::to_tablename $chan]
+  hist::ensure $db $chan
+}
+
+proc hist::open {db path} {
+  variable known_channels
+  sqlite3 $db $path
+  set known_channels($db) {}
+  lappend ::db::autocleanup_dbs $db
+}

@@ 1,5 1,7 @@
 #!/bin/env tclsh
 
+set version 0.0.1
+
 set boot_dir [pwd]
 cd [file dirname [dict get [info frame [info frame]] file]]
 


@@ 8,9 10,22 @@ puts "pwd=[pwd]"
 
 source persist.tcl
 source deps.tcl
+source util.tcl
 
 set log [logger::init tclircc::main]
 
-sqlite3 core_db [file join $data_dir core.db]
+source db.tcl
+db::init_core $data_dir
+source db/networks.tcl
+
+source history.tcl
+hist::open hist_db [file join $data_dir foo.db]
+hist::ensure hist_db #foo
+
+# cleanup every 6 hours, should be heuristic-driven eventually
+db::autocleanup [expr {6 * 60 * 60 * 1000}]
 
-source migrate_core.tcl
+source ui.tcl
+wm withdraw .
+toplevel .mainwin
+ui::basic::setup .mainwin

@@ 15,3 15,5 @@ switch -- [set tcl_platform(platform)] {
     return -code error {Unknown platform, can't store config.}
   }
 }
+
+file mkdir $data_dir

@@ 0,0 1,106 @@
+namespace eval ui {}
+namespace eval ui::basic {}
+
+proc ui::basic::setup {mount} {
+  global version
+
+  menu $mount.menu
+  $mount configure -menu "$mount.menu"
+
+  menu $mount.menu.conn
+  menu $mount.menu.server
+
+  menu $mount.menu.me
+  $mount.menu.me add command -label "About" -command [subst {
+    tk_messageBox -title "About tclircc" \
+                  -message "tclircc $version" \
+                  -detail "by Aleteoryx\nhttps://amehut.dev/~aleteoryx/tclircc\n\nThis software is in the public domain." \
+                  -type ok \
+                  -parent $mount }]
+
+  $mount.menu add cascade -label "connections" -menu $mount.menu.conn
+  $mount.menu add cascade -label "networks" -menu $mount.menu.network
+  $mount.menu add cascade -label "tclircc" -menu $mount.menu.me
+}
+proc ui::basic::teardown {mount} {
+  destroy $mount.menu
+}
+
+namespace eval ui::form {
+  variable forms
+  variable form_n 0
+}
+
+proc ui::form::show {title heading fields check finish cancel} {
+  variable forms
+  variable form_n
+  set tl .form$form_n
+  incr form_n
+
+  set forms(${tl}) [list fields $fields  check $check  finish $finish  cancel $cancel]
+
+  set pad_n 0
+
+  toplevel $tl
+  wm title $tl $title
+  label $tl.heading -text $heading -font TkHeadingFont
+  pack $tl.heading -side top
+  frame $tl.pad$pad_n -height 10
+  pack $tl.pad$pad_n -side top
+  incr pad_n
+
+  foreach {framed text widget name args} $fields {
+    if {$framed} {
+      frame $tl.field_$name
+      label $tl.field_$name.lbl -text $text
+      $widget $tl.field_$name.wgt {*}$args ::ui::form::forms(${tl}:$name)
+      pack $tl.field_$name.lbl -side left
+      pack $tl.field_$name.wgt -side right
+      pack $tl.field_$name -side top -anchor w
+    } else {
+      label $tl.field_${name}_lbl -text $text
+      $widget $tl.field_${name}_wgt {*}$args ::ui::form::forms(${tl}:$name)
+      pack $tl.field_${name}_lbl -side top -anchor w
+      pack $tl.field_${name}_wgt -side top -anchor w
+    }
+    label $tl.field_${name}_err -height 0
+    pack $tl.field_${name}_err -side top -anchor w
+    frame $tl.pad$pad_n -height 10
+    pack $tl.pad$pad_n -side top
+    incr pad_n
+  }
+
+  frame $tl.buttons
+  button $tl.buttons.cancel -text "Cancel" -command [concat [list set tl $tl] {;
+    array unset ::ui::form::forms($tl)
+    array unset ::ui::form::forms(${tl}:*)
+    destroy $tl
+    eval [dict get [set ::ui::form::forms($tl)] cancel]
+  }]
+  button $tl.buttons.ok -text "Ok" -command [concat [list set tl $tl] {;
+    set formdata {}
+    foreach {framed text widget name args} [dict get [set ::ui::form::forms($tl)] fields] {
+      dict set formdata $name [set ::ui::form::forms(${tl}:$name)]
+    }
+
+    if {[set errs [eval [dict get [set ::ui::form::forms($tl)] check]]] != {}} {
+      ...
+    } else {
+      array unset ::ui::form::forms($tl)
+      array unset ::ui::form::forms(${tl}:*)
+      destroy $tl
+      eval [dict get [set ::ui::form::forms($tl)] finish]
+    }
+  }]
+  bind $tl <Destroy> {
+    if {[info exists ::ui::form::forms(%W)]} {
+      array unset ::ui::form::forms(%W)
+      array unset ::ui::form::forms(%W:*)
+      eval [dict get [set ::ui::form::forms(%W)] cancel]
+    }
+  }
+
+  pack $tl.buttons.cancel -side left
+  pack $tl.buttons.ok -side left
+  pack $tl.buttons -side top -anchor w
+}

@@ 0,0 1,5 @@
+set randchan [tcl::chan::random [tcl::randomseed]]
+proc rand_hex {} {
+  global randchan
+  return [binary encode hex [read randchan 8]]
+}