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
#!/bin/env tclsh
cd [file dirname [dict get [info frame [info frame]] file]]
package require logger
package require json
package require json::write
package require sqlite3
package require inifile
package require sha1
source src/config.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]
set logd [logger::init tclfeed::database]
${log}::info "tclfeed v0.0.1"
### DB STUFF ###
sqlite3 db [::ini::value $config database path]
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);"
}
}
}
}
proc db_cleanup {interval max_posts} {
global ::algos::list logd
${logd}::info "Performing database cleanup!"
foreach algo $::algos::list {
# slightly cursed
db eval "DELETE FROM $algo WHERE uri IN (SELECT uri FROM $algo ORDER BY ord DESC LIMIT -1 OFFSET :max_posts); REINDEX $algo;"
}
db eval "VACUUM";
${logd}::info "DB cleanup completed without error!"
${logd}::debug "Scheduling next cleanup for [clock format [expr {[clock seconds] + $interval}]]."
after [expr {$interval * 1000}] [list db_cleanup $interval $max_posts]
}
db_cleanup [::ini::value $config database cleanup_interval] [::ini::value $config database max_posts]
### JETSTREAM ###
jetstream::listen [::ini::value $config atproto jetstream_host] $::algos::list
### HTTPD ###
set routes {}
set well_known [
::feed::well_known \
$::algos::list \
[::ini::value $config atproto self_host]]
lappend routes /.well-known/did.json \
[list ::httpd::serve application/json $well_known]
lappend routes /xrpc/app.bsky.feed.getFeedSkeleton \
[list ::feed::serve_skeleton $::algos::list [::ini::value $config atproto publisher_did]]
set generator_description [
::feed::generator_description \
$::algos::list \
[::ini::value $config atproto publisher_did] \
[::ini::value $config atproto self_host]]
lappend /xrpc/app.bsky.feed.describeFeedGenerator \
[list ::httpd::serve application/json $generator_description]]
httpd::router main $routes
httpd::listen main [::ini::value $config httpd port]
vwait nil