11 files changed, 89 insertions(+), 28 deletions(-)

R jetstream-stats.tcl => bin/jetstream-stats.tcl
R config.ini => config.example.ini
M main.tcl
A src/algos.tcl
A src/algos/tclposting.tcl
A src/at.tcl
R config.tcl => src/config.tcl
R feed.tcl => src/feed.tcl
R httpd.tcl => src/httpd.tcl
R jetstream.tcl => src/jetstream.tcl
R ws.tcl => src/ws.tcl

@@ 4,3 4,4 @@ max_posts = 10000
 
 [atproto]
 jetstream_host = jetstream2.us-east.bsky.network
+publisher_did = ; your atproto did

@@ 6,34 6,42 @@ package require sqlite3
 package require inifile
 package require sha1
 
-source config.tcl
+source src/config.tcl
 
-source ws.tcl
-source jetstream.tcl
-source httpd.tcl
-source feed.tcl
+source src/at.tcl
+source src/ws.tcl
+source src/jetstream.tcl
+source src/httpd.tcl
+source src/feed.tcl
+
+source src/algos.tcl
 
 set log [logger::init tclfeed]
 ${log}::info "tclfeed v0.0.1"
 
-#::json::write indented 0
-
 ### DB STUFF ###
 sqlite3 db [::ini::value $config database path]
-db eval {SELECT count(*) as n FROM sqlite_master WHERE name="posts";} values {
-  if ![set values(n)] {
-    ${log}::info "Initializing db!"
-    db eval {CREATE TABLE posts (uri TEXT NOT NULL PRIMARY KEY, ts TEXT NOT NULL);}
+
+foreach algo $::algos::list {
+  db eval {SELECT count(*) as n FROM sqlite_master WHERE name=$algo;} values {
+    if ![set values(n)] {
+      ${log}::info "Creating table \"$algo\"!"
+      if [info exists ::algos::${algo}::cols] {
+        db eval "CREATE TABLE $algo (uri TEXT NOT NULL PRIMARY KEY, ord TEXT NOT NULL, [set ::algos::${algo}::cols]);"
+      } else {
+        db eval "CREATE TABLE $algo (uri TEXT NOT NULL PRIMARY KEY, ord TEXT NOT NULL);"
+      }
+    }
   }
 }
 
 ### JETSTREAM ###
-jetstream::listen [::ini::value $config atproto jetstream_host] db
+jetstream::listen [::ini::value $config atproto jetstream_host] $::algos::list
 
 ### HTTPD ###
-httpd::router main {
-  /xrpc/app.bsky.feed.getFeedSkeleton {::feed::serve_skeleton {tcl posts}}
-}
+httpd::router main [list \
+  /xrpc/app.bsky.feed.getFeedSkeleton [list ::feed::serve_skeleton $::algos::list] \
+]
 httpd::listen main 3000
 
 vwait nil

@@ 0,0 1,9 @@
+namespace eval ::algos { variable list {} }
+
+foreach file [glob src/algos/*.tcl] {
+  source $file
+}
+
+foreach algo [namespace children ::algos] {
+  lappend ::algos::list [lindex [split $algo :] end]
+}

@@ 0,0 1,10 @@
+namespace eval ::algos::tclposting {
+  variable log [logger::init algos::tclposting]
+  proc intake {uri text data} {
+    variable log
+    if {[regexp -- {\s[Tt]cl(/[Tt]k)?(\.|,|\s)|^[Tt]cl(/[Tt]k)?(,|\s)|\s[Tt]cl(/[Tt]k)?$|\sTk(\.|,|\s)|^Tk(,|\s)|\sTk$|\.tcl|tclsh|tcl-lang|tcltk|tcllib|tklib|tcl\.tk|#tcllang} $text]} {
+      return [dict get $data commit record createdAt]
+    }
+    return {}
+  }
+}

@@ 0,0 1,15 @@
+namespace eval at {
+  # conformant enough, i hope
+  proc uri {uri} {
+    if {[string first "at://" $uri] != 0} return
+    set uri [string range $uri 5 end]
+    set uri [split $uri /]
+
+    switch -- [llength $uri] {
+      1 { return [list authority [lindex $uri 0]] }
+      2 { return [list authority [lindex $uri 0] collection [lindex $uri 1]] }
+      3 { return [list authority [lindex $uri 0] collection [lindex $uri 1] rkey [lindex $uri 2]] }
+      default { return {} }
+    }
+  }
+}

@@ 1,5 1,7 @@
 namespace eval feed {
   proc ::feed::serve_skeleton {feeds _ sock path query headers} {
+    global config
+
     if ![dict exists $query feed] {
       puts $sock "HTTP/1.0 400 Bad Request"
       puts $sock "Content-Type: text/plain"


@@ 30,21 32,34 @@ namespace eval feed {
       return
     }
 
-    if ![dict exists $feeds $feed] {
-      puts $sock "HTTP/1.0 404 Not Found"
+    set feed [::at::uri $feed]
+
+    if {[llength $feed] != 6 ||
+        [dict get $feed authority] != [::ini::value $config atproto publisher_did] ||
+        [dict get $feed collection] != "app.bsky.feed.generator"} {
+      puts $sock "HTTP/1.0 400 Bad Request"
       puts $sock "Content-Type: text/plain"
       puts $sock ""
-      puts $sock "Not a feed."
+      puts $sock "Invalid at:// URI."
       puts $sock ""
       close $sock
       return
     }
 
-    set table [dict get $feeds $feed]
+    set feed [dict get $feed rkey]
 
+    if {[lsearch -exact $feeds $feed] == -1} {
+      puts $sock "HTTP/1.0 404 Not Found"
+      puts $sock "Content-Type: text/plain"
+      puts $sock ""
+      puts $sock "Not a feed."
+      puts $sock ""
+      close $sock
+      return
+    }
 
     set feed_data {}
-    foreach uri [db eval "SELECT uri FROM $table ORDER BY ts LIMIT $limit OFFSET $cursor;"] {
+    foreach uri [db eval "SELECT uri FROM $feed ORDER BY ord LIMIT $limit OFFSET $cursor;"] {
       lappend feed_data [::json::write object post [::json::write string $uri]]
     }
     set feed_data [::json::write array {*}$feed_data]


@@ 54,7 69,7 @@ namespace eval feed {
     puts $sock "Content-Type: application/json"
     puts $sock "Content-Length: [string length $feed_contents]"
     puts $sock ""
-    fconfigure $sock -translation lf
+    fconfigure $sock -translation binary
     puts -nonewline $sock $feed_contents
     close $sock
     return

@@ 1,6 1,6 @@
 namespace eval ::jetstream {
   variable log [logger::init tclfeed::jetstream]
-  proc listen {host db} {
+  proc listen {host algos} {
     variable log
 
     ${log}::info "listening to jetstream on wss://$host/subscribe"


@@ 10,7 10,7 @@ namespace eval ::jetstream {
       list ::ws::c::connect $host 443 \
       /subscribe?wantedCollections=app.bsky.feed.post on_ws_$postfix]
 
-    proc ::jetstream::on_ws_$postfix {sock mode data} [concat [list set db $db] \; [list set postfix $postfix] \; {
+    proc ::jetstream::on_ws_$postfix {sock mode data} [concat [list set postfix $postfix] \; [list set algos $algos] \; {
       variable log
       switch -- $mode {
         close {


@@ 27,15 27,18 @@ namespace eval ::jetstream {
           switch -- [dict get $data commit operation] {
             create {
               set text [dict get $data commit record text]
-              if {[regexp -- {\s[Tt]cl(/[Tt]k)?(\.|,|\s)|^[Tt]cl(/[Tt]k)?(,|\s)|\s[Tt]cl(/[Tt]k)?$|\sTk(\.|,|\s)|^Tk(,|\s)|\sTk$|\.tcl|tclsh|tcl-lang|tcltk|tcllib|tklib|tcl\.tk|#tcllang} $text]} {
-                set ts [dict get $data commit record createdAt]
-                if ![catch {$db eval {INSERT OR FAIL INTO posts (uri, ts) VALUES ($uri, $ts);}}] {
-                  ${log}::info "new tclpost! https://bsky.app/profile/[dict get $data did]/post/[dict get $data commit rkey]"
+              foreach algo $algos {
+                if {[set ord [::algos::${algo}::intake $uri $text $data]] != {}} {
+                  if ![catch {db eval "INSERT OR FAIL INTO $algo (uri, ord) VALUES (:uri, :ord);"}] {
+                    ${log}::info "new post for feed \"$algo\"! https://bsky.app/profile/[dict get $data did]/post/[dict get $data commit rkey]"
+                  }
                 }
               }
             }
             delete {
-              $db eval {DELETE FROM posts WHERE uri = $uri;}
+              foreach algo $algos {
+                db eval "DELETE FROM $algo WHERE uri = :uri;"
+              }
             }
           }
         }