# Announces new Trump posts via trumpstruth.org RSS
# Feed: https://www.trumpstruth.org/feed
# Detects ridiculous Trump-isms using pattern matching
catch {setudef flag enabletruth}
catch {setudef flag enableTruth}
namespace eval ::trumptruthrss {
variable cfg
array set cfg {
feed_url "https://www.trumpstruth.org/feed"
poll_seconds 3600
curl "/usr/bin/curl"
curl_timeout 15
user_agent "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/143.0.0.0 Safari/537.36"
state_file "trumptruthrss.state"
max_chars 420
strip_non_ascii 1
exclude_retruths 1
max_new_announce 5
debug 0
min_findings 1
}
variable last_guid ""
variable in_progress 0
variable timer_id ""
}
if {[info commands lreverse] eq ""} {
proc lreverse {lst} {
set out {}
foreach x $lst { set out [linsert $out 0 $x] }
return $out
}
}
proc ::trumptruthrss::dlog {msg} {
variable cfg
if {$cfg(debug)} { putlog "trumptruthrss: $msg" }
}
proc ::trumptruthrss::chan_enabled {chan} {
if {![catch {set v [channel get $chan enabletruth]}]} { return $v }
if {![catch {set v [channel get $chan enableTruth]}]} { return $v }
putlog "trumptruthrss: channel flag enabletruth/enableTruth not defined"
return 0
}
proc ::trumptruthrss::enabled_channels {} {
set out {}
foreach c [channels] {
if {[::trumptruthrss::chan_enabled $c]} { lappend out $c }
}
return $out
}
proc ::trumptruthrss::load_state {} {
variable cfg; variable last_guid
if {![file exists $cfg(state_file)]} { set last_guid ""; return }
catch {
set f [open $cfg(state_file) r]
set last_guid [string trim [read $f]]
close $f
}
}
proc ::trumptruthrss::save_state {} {
variable cfg; variable last_guid
catch {
set f [open $cfg(state_file) w]
puts $f $last_guid
close $f
}
}
proc ::trumptruthrss::is_retruth {item} {
set raw [string tolower [dict get $item text]]
if {[string first "retruth" $raw] >= 0} { return 1 }
set clean [string tolower [::trumptruthrss::strip_html [dict get $item text]]]
if {[string first "rt @" $clean] == 0} { return 1 }
return 0
}
proc ::trumptruthrss::curl_fetch {url} {
variable cfg
set cmd [list $cfg(curl) -s -L --compressed -m $cfg(curl_timeout) \
-H "Accept: application/rss+xml, application/xml;q=0.9, */*;q=0.8" \
-H "User-Agent: $cfg(user_agent)" \
-w "\n__CURLMETA__:%{http_code}:%{content_type}\n" \
$url]
dlog "Fetching: $url"
if {[catch {set out [eval exec $cmd]} err]} {
putlog "trumptruthrss: curl failed: $err"
return [list 0 "" ""]
}
set code 0; set ctype ""
if {[regexp {__CURLMETA__:(\d+):([^\r\n]+)} $out -> code ctype]} {
regsub {(\r?\n)?__CURLMETA__:[0-9]+:[^\r\n]+(\r?\n)?$} $out "" body
} else { set body $out }
dlog "HTTP $code (ctype=$ctype) bytes=[string length $body]"
return [list $code $ctype $body]
}
proc ::trumptruthrss::html_decode {s} {
set s [string map {
"&" "&" "<" "<" ">" ">"
""" "\"" """ "\"" "'" "'"
"'" "'" " " " "
} $s]
return $s
}
proc ::trumptruthrss::strip_html {html} {
set s $html
regsub -all -nocase {<br\s*/?>} $s "\n" s
regsub -all -nocase {</p>\s*<p>} $s "\n" s
regsub -all {<[^>]+>} $s "" s
set s [::trumptruthrss::html_decode $s]
regsub -all {[[:space:]]+} $s " " s
return [string trim $s]
}
proc ::trumptruthrss::rss_gettag {block tag} {
set open "<$tag"; set close "</$tag>"
set i [string first $open $block]; if {$i < 0} { return "" }
set gt [string first ">" $block $i]; if {$gt < 0} { return "" }
set j [string first $close $block $gt]; if {$j < 0} { return "" }
set val [string trim [string range $block [expr {$gt+1}] [expr {$j-1}]]]
if {[string first {<![CDATA[} $val] == 0} {
set end [string last {]]>} $val]
if {$end > 9} { set val [string trim [string range $val 9 [expr {$end-1}]]] }
}
return $val
}
proc ::trumptruthrss::parse_feed {xml} {
set head [string tolower [string range $xml 0 200]]
if {[string first "<!doctype" $head] >= 0 || [string first "<html" $head] >= 0} {
putlog "trumptruthrss: Got HTML instead of RSS/XML."; return {}
}
if {[string first "<?xml" $head] < 0 && [string first "<rss" $head] < 0 && \
[string first "<feed" $head] < 0} {
putlog "trumptruthrss: Response doesn't look like RSS/XML."; return {}
}
set items {}; set pos 0
while {1} {
set s [string first "<item" $xml $pos]; if {$s < 0} break
set e [string first "</item>" $xml $s]; if {$e < 0} break
lappend items [string range $xml $s [expr {$e+6}]]
set pos [expr {$e+7}]
}
if {[llength $items] == 0} { putlog "trumptruthrss: No <item> elements found."; return {} }
set out {}
foreach it $items {
set guid [rss_gettag $it "guid"]; set link [rss_gettag $it "link"]
set title [rss_gettag $it "title"]; set desc [rss_gettag $it "description"]
set enc [rss_gettag $it "content:encoded"]; set pub [rss_gettag $it "pubDate"]
set text [expr {$enc ne "" ? $enc : ($desc ne "" ? $desc : $title)}]
if {$guid eq ""} { set guid [expr {$link ne "" ? $link : $title}] }
lappend out [dict create guid $guid link $link text $text pubDate $pub]
}
return $out
}
# -----------------------------------------------------------------------
# THE RIDICULOUS-O-METER
# Each detector returns a short snarky string, or "" if not triggered.
# -----------------------------------------------------------------------
proc ::trumptruthrss::detect_caps {text} {
# Count ALL-CAPS words (3+ letters, not abbreviations like USA/FBI we expect)
set words [regexp -all -inline {[A-Z]{3,}} $text]
# Filter out the common expected ones
set noise {USA FBI CIA DOJ GOP DNC NBC ABC CBS CNN FOX GOP NATO GOP URL RSS}
set shouted {}
foreach w $words {
if {[lsearch -exact $noise $w] < 0} { lappend shouted $w }
}
set n [llength $shouted]
if {$n >= 4} { return "$n words needlessly screamed in caps" }
if {$n >= 2} { return "randomly screaming: [join [lrange $shouted 0 2] {, }]" }
return ""
}
proc ::trumptruthrss::detect_exclamations {text} {
set n [regexp -all {!} $text]
if {$n >= 5} { return "$n exclamation marks (calm down!!!)" }
if {$n >= 3} { return "$n exclamation marks used" }
return ""
}
proc ::trumptruthrss::detect_self_obsession {text} {
set lower [string tolower $text]
# Count standalone first-person words using word boundaries
set count [regexp -all {\m(i|me|my|myself|mine)\M} $lower]
if {$count >= 8} { return "refers to himself $count times in one post" }
if {$count >= 5} { return "$count first-person references (it's always about him)" }
return ""
}
proc ::trumptruthrss::detect_superlatives {text} {
set lower [string tolower $text]
set found {}
foreach pattern {
{the greatest} {the best ever} {the worst ever} {the biggest}
{the most beautiful} {the most powerful} {nobody has ever}
{the most successful} {better than anyone} {like nobody has seen}
{the best in history} {the greatest ever} {the most incredible}
{the most popular} {number one} {like never before}
} {
if {[string first $pattern $lower] >= 0} { lappend found $pattern }
}
if {[llength $found] >= 2} { return "stacked [llength $found] superlatives in one post" }
if {[llength $found] == 1} { return "claims to be [lindex $found 0]" }
return ""
}
proc ::trumptruthrss::detect_conspiracy_words {text} {
set lower [string tolower $text]
set hits {}
foreach phrase {
{witch hunt} {fake news} {rigged}
{hoax} {deep state} {enemy of the people}
{corrupt} {disgrace} {it was stolen}
{radical left} {they are destroying} {no other president}
{russia russia russia} {pedo} {human scum}
{very unfair} {many people are saying} {everybody knows}
{total disaster} {completely made up} {mainstream media}
{lamestream} {do nothing} {should be ashamed}
} {
if {[string first $phrase $lower] >= 0} { lappend hits $phrase }
}
if {[llength $hits] >= 3} { return "packed with [llength $hits] grievance buzzwords" }
if {[llength $hits] == 2} { return "invokes: [join $hits { and }]" }
if {[llength $hits] == 1} { return "playing the '[lindex $hits 0]' card again" }
return ""
}
proc ::trumptruthrss::detect_nicknames {text} {
set lower [string tolower $text]
set names {}
foreach n {
{crooked} {sleepy} {crazy} {radical} {wacky}
{failing} {nasty} {slippery} {liddle} {pencil neck}
{low iq} {dumb} {dummy} {clown} {loser}
{weak} {corrupt} {cryin} {mini mike} {pocahontas}
{lyin} {shifty} {slimeball}
} {
if {[string first $n $lower] >= 0} { lappend names $n }
}
if {[llength $names] >= 2} { return "name-calls [llength $names] people/things" }
if {[llength $names] == 1} { return "uses nickname: '[lindex $names 0]'" }
return ""
}
proc ::trumptruthrss::detect_believe_me {text} {
set lower [string tolower $text]
set phrases {}
foreach p {
{believe me} {trust me} {everybody knows}
{many people are saying} {people are saying} {a lot of people think}
{everyone agrees} {nobody knows more} {i know more about}
{i alone can} {only i can} {nobody could have}
} {
if {[string first $p $lower] >= 0} { lappend phrases $p }
}
if {[llength $phrases] >= 2} { return "asks you to just trust him [llength $phrases] times" }
if {[llength $phrases] == 1} { return "\"[lindex $phrases 0]\" (citation needed)" }
return ""
}
proc ::trumptruthrss::detect_random_caps_nouns {text} {
# Look for Title Case words mid-sentence that aren't after a period/! or a known proper noun
# Simple heuristic: capitalised word NOT at start of sentence and not all-caps
set words [regexp -all -inline {\s[A-Z][a-z]{2,}} $text]
set noise {Trump Donald America American United States January Congress President Senate House}
set odd {}
foreach w $words {
set w [string trim $w]
if {[lsearch -exact $noise $w] < 0} { lappend odd $w }
}
# Deduplicate
set odd [lsort -unique $odd]
set n [llength $odd]
if {$n >= 5} { return "randomly capitalises $n nouns like a German textbook" }
if {$n >= 3} { return "mystery caps: [join [lrange $odd 0 2] {, }]..." }
return ""
}
proc ::trumptruthrss::detect_numbers {text} {
set lower [string tolower $text]
set hits {}
# Suspiciously round or large numbers
foreach pattern {
{\d+ million people} {\d+ billion} {100 percent}
{100%} {millions and millions} {\d{2,} points}
{number one in history} {record setting} {all time record}
{best numbers ever} {highest ever} {lowest ever}
} {
if {[regexp $pattern $lower]} { lappend hits $pattern }
}
if {[llength $hits] >= 2} { return "throws out [llength $hits] suspiciously round statistics" }
if {[llength $hits] == 1} { return "cites a very specific but unverifiable statistic" }
return ""
}
proc ::trumptruthrss::detect_threats {text} {
set lower [string tolower $text]
set found {}
foreach p {
{will be prosecuted} {should be in jail} {lock}
{will pay a big price} {i will} {very unfair}
{will be held accountable} {consequences} {price to pay}
{come after} {never forget} {be careful}
} {
if {[string first $p $lower] >= 0} { lappend found $p }
}
if {[llength $found] >= 2} { return "vaguely threatens people [llength $found] times" }
if {[llength $found] == 1} { return "issues ominous warning: '[lindex $found 0]'" }
return ""
}
# -----------------------------------------------------------------------
# Run all detectors, return list of findings (max 3 most interesting)
# -----------------------------------------------------------------------
proc ::trumptruthrss::analyse {text} {
set findings {}
foreach detector {
detect_conspiracy_words
detect_caps
detect_self_obsession
detect_nicknames
detect_superlatives
detect_believe_me
detect_exclamations
detect_random_caps_nouns
detect_numbers
detect_threats
} {
set result [::trumptruthrss::$detector $text]
if {$result ne ""} { lappend findings $result }
if {[llength $findings] >= 3} { break }
}
return $findings
}
# -----------------------------------------------------------------------
# Convert an RFC 822 pubDate to Europe/London time (GMT or BST as appropriate).
# Falls back to the original string if Tcl can't parse it.
# -----------------------------------------------------------------------
proc ::trumptruthrss::is_bst {epoch} {
# Returns 1 if the UTC epoch falls inside British Summer Time.
# BST runs from the last Sunday of March 01:00 UTC
# to the last Sunday of October 01:00 UTC.
set year [clock format $epoch -format "%Y" -gmt 1]
# Last Sunday of March at 01:00 UTC
set mar31 [clock scan "$year-03-31 01:00:00" -format "%Y-%m-%d %H:%M:%S" -gmt 1]
set dow [clock format $mar31 -format "%w" -gmt 1]
set bst_start [expr {$mar31 - $dow * 86400}]
# Last Sunday of October at 01:00 UTC
set oct31 [clock scan "$year-10-31 01:00:00" -format "%Y-%m-%d %H:%M:%S" -gmt 1]
set dow [clock format $oct31 -format "%w" -gmt 1]
set bst_end [expr {$oct31 - $dow * 86400}]
return [expr {$epoch >= $bst_start && $epoch < $bst_end}]
}
proc ::trumptruthrss::localise_date {pub} {
if {$pub eq ""} { return "" }
if {[catch {
# Strip the trailing timezone offset (+0000 etc.) and parse as UTC.
# Uses -gmt 1 instead of -timezone for compatibility with older Tcl builds.
regsub {\s+[+-]\d{4}\s*$} $pub "" dateonly
set epoch [clock scan $dateonly -gmt 1]
if {[::trumptruthrss::is_bst $epoch]} {
set local [clock format [expr {$epoch + 3600}] -format "%a %d %b %Y %H:%M BST" -gmt 1]
} else {
set local [clock format $epoch -format "%a %d %b %Y %H:%M GMT" -gmt 1]
}
} err]} {
putlog "trumptruthrss: localise_date failed for '$pub': $err"
return $pub
}
return $local
}
# -----------------------------------------------------------------------
# Random eye-catching prefix for ridiculous posts
# -----------------------------------------------------------------------
proc ::trumptruthrss::random_prefix {} {
set prefixes {
"Praise Allah!"
"Allahu Akbar!"
"Bismillah!"
"As the Quran foretold:"
"From the Mar-a-Lago mosque:"
"BREAKING: The orange one has spoken:"
"ALERT: Tiny hands on keyboard:"
"Oh no, he's at his phone again:"
"Covfefe alert:"
"Stand by for tremendous words:"
"The stable genius writes:"
"Fox News is on in the background:"
"3am Truth Social dispatch:"
"The golf cart has stopped:"
"Mar-a-Lago WiFi password: MAGA2024:"
"Someone take his phone:"
"The hamberder has been digested:"
"His lawyer is crying somewhere:"
"Historians will study this:"
"Hold onto your toupee:"
"The greatest post in history:"
"Unprompted and unhinged:"
"Nobody asked but here it is:"
"The world waits with bated breath:"
"Science cannot explain this:"
}
return [lindex $prefixes [expr {int(rand() * [llength $prefixes])}]]
}
# -----------------------------------------------------------------------
# Format item. Returns "" if not ridiculous enough (skip it).
# force=1 bypasses the threshold (used by !truth command).
# -----------------------------------------------------------------------
proc ::trumptruthrss::format_item {item {force 0}} {
variable cfg
set text [::trumptruthrss::strip_html [dict get $item text]]
regsub -all {[[:space:]]+} $text " " text
set text [string trim $text]
if {$cfg(strip_non_ascii)} { regsub -all {[^\x00-\x7F]} $text "" text }
set pub [::trumptruthrss::localise_date [dict get $item pubDate]]
set link [dict get $item link]
# Skip posts with no readable text or that are just a URL
if {!$force} {
if {$text eq ""} { return "" }
# Strip all URLs out and see if anything real is left
set textonly $text
regsub -all {https?://[^[:space:]]+} $textonly "" textonly
set textonly [string trim $textonly]
if {$textonly eq ""} { return "" }
}
set findings [::trumptruthrss::analyse $text]
dlog "Findings for post: $findings"
if {!$force && [llength $findings] < $cfg(min_findings)} {
dlog "Skipping post - only [llength $findings] findings"
return ""
}
# Build suffix: findings | date | link
set suffix ""
if {[llength $findings] > 0} {
append suffix " \["
set n 1
foreach f $findings {
if {$n > 1} { append suffix " |" }
append suffix " ($n) $f"
incr n
}
append suffix " \]"
}
if {$pub ne ""} { append suffix " | $pub" }
if {$link ne ""} { append suffix " | $link" }
# Keep the post snippet short and punchy (120 chars)
set snippet_limit 120
if {[string length $text] > $snippet_limit} {
set text "[string range $text 0 [expr {$snippet_limit - 4}]]..."
}
set prefix "[::trumptruthrss::random_prefix] "
# Final safety trim to IRC limit
set available [expr {440 - [string length $prefix] - [string length $suffix]}]
if {[string length $text] > $available} {
set text "[string range $text 0 [expr {$available - 4}]]..."
}
return "${prefix}$text$suffix"
}
proc ::trumptruthrss::announce_items {items} {
set chans [::trumptruthrss::enabled_channels]
if {[llength $chans] == 0} { return }
foreach it $items {
set msg [::trumptruthrss::format_item $it]
if {$msg eq ""} { continue }
foreach c $chans { putserv "PRIVMSG $c :$msg" }
}
}
proc ::trumptruthrss::schedule {} {
variable cfg; variable timer_id
if {$timer_id ne ""} { catch {killutimer $timer_id} }
set timer_id [utimer $cfg(poll_seconds) ::trumptruthrss::poll]
}
proc ::trumptruthrss::poll {} {
variable cfg; variable last_guid; variable in_progress
::trumptruthrss::schedule
if {$in_progress} { return }
set in_progress 1
if {[llength [::trumptruthrss::enabled_channels]] == 0} { set in_progress 0; return }
lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
if {$code != 200 || $body eq ""} {
putlog "trumptruthrss: fetch failed (HTTP=$code)"
set in_progress 0; return
}
set items [::trumptruthrss::parse_feed $body]
if {[info exists cfg(exclude_retruths)] && $cfg(exclude_retruths)} {
set filtered {}
foreach it $items { if {![::trumptruthrss::is_retruth $it]} { lappend filtered $it } }
set items $filtered
}
if {[llength $items] == 0} { set in_progress 0; return }
if {$last_guid eq ""} {
set last_guid [dict get [lindex $items 0] guid]
::trumptruthrss::save_state
set in_progress 0; return
}
set new {}
foreach it $items {
if {[dict get $it guid] eq $last_guid} break
lappend new $it
}
if {[llength $new] == 0} { set in_progress 0; return }
if {[llength $new] > $cfg(max_new_announce)} {
set new [lrange $new 0 [expr {$cfg(max_new_announce)-1}]]
}
::trumptruthrss::announce_items [lreverse $new]
set last_guid [dict get [lindex $items 0] guid]
::trumptruthrss::save_state
set in_progress 0
}
proc ::trumptruthrss::cmd_latest {nick host hand chan text} {
if {![::trumptruthrss::chan_enabled $chan]} { return }
lassign [::trumptruthrss::curl_fetch $::trumptruthrss::cfg(feed_url)] code ctype body
if {$code != 200 || $body eq ""} {
putserv "PRIVMSG $chan :Orange Truth: (error) couldn't fetch feed (HTTP=$code)."
return
}
set items [::trumptruthrss::parse_feed $body]
if {[llength $items] == 0} {
putserv "PRIVMSG $chan :Orange Truth: (error) couldn't parse feed."
return
}
set msg [::trumptruthrss::format_item [lindex $items 0] 1]
if {$msg eq ""} { set msg "Orange Truth: surprisingly restrained post, nothing to report." }
putserv "PRIVMSG $chan :$msg"
}
proc ::trumptruthrss::cmd_sync {nick host hand chan text} {
variable last_guid
if {![::trumptruthrss::chan_enabled $chan]} { return }
lassign [::trumptruthrss::curl_fetch $::trumptruthrss::cfg(feed_url)] code ctype body
if {$code != 200 || $body eq ""} {
putserv "PRIVMSG $chan :Orange Truth: (error) couldn't sync (HTTP=$code)."
return
}
set items [::trumptruthrss::parse_feed $body]
if {[llength $items] == 0} {
putserv "PRIVMSG $chan :Orange Truth: (error) couldn't parse feed."
return
}
set new {}
if {$last_guid ne ""} {
foreach it $items {
if {[dict get $it guid] eq $last_guid} break
lappend new $it
}
} else { set new $items }
# Update state pointer without announcing anything
set last_guid [dict get [lindex $items 0] guid]
::trumptruthrss::save_state
set n [llength $new]
if {$n == 0} {
putserv "PRIVMSG $chan :Orange Truth: already up to date."
} else {
putserv "PRIVMSG $chan :Orange Truth: synced, skipped $n post[expr {$n == 1 ? {} : {s}}]. Use !truth to see the latest."
}
}
catch {unbind pub - "!truth" ::trumptruthrss::cmd_latest}
catch {unbind pub - "!truthsync" ::trumptruthrss::cmd_sync}
bind pub - "!truth" ::trumptruthrss::cmd_latest
bind pub - "!truthsync" ::trumptruthrss::cmd_sync
::trumptruthrss::load_state
::trumptruthrss::schedule
putlog "truthtrump.tcl loaded - Enable with: .chanset #chan +enabletruth"