Trumptruths.tcl


# Announces new Trump posts via trumpstruth.org RSS
# Feed: https://www.trumpstruth.org/feed

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
  }

  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} {
  # look for "ReTruth", "RT @user ..."
  # Sometimes the link points away from @realDonaldTrump
  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 }

  if {[dict exists $item link]} {
    set link [string tolower [dict get $item link]]
    if {$link ne "" && [string first "%40realdonaldtrump" $link] < 0 && [string first "/@realdonaldtrump" $link] < 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 {
    "&amp;"  "&"
    "&lt;"   "<"
    "&gt;"   ">"
    "&quot;" "\""
    "&#34;"  "\""
    "&#39;"  "'"
    "&apos;" "'"
    "&nbsp;" " "
  } $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 range $block [expr {$gt+1}] [expr {$j-1}]]
  set val [string trim $val]

        if {[string first {<![CDATA[} $val] == 0} {
          set end [string last {]]>} $val]
          if {$end > 9} {
                set val [string range $val 9 [expr {$end-1}]]
                set val [string trim $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. Head: [string range $xml 0 120]"
    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 ""
    if {$enc ne ""} {
      set text $enc
    } elseif {$desc ne ""} {
      set text $desc
    } else {
      set text $title
    }

    if {$guid eq ""} {
      if {$link ne ""} { set guid $link } else { set guid $title }
    }

    lappend out [dict create guid $guid link $link text $text pubDate $pub]
  }
  return $out
}

proc ::trumptruthrss::format_item {item} {
  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
  }

  if {[string length $text] > $cfg(max_chars)} {
    set text "[string range $text 0 [expr {$cfg(max_chars)-4}]]..."
  }

  set pub [dict get $item pubDate]
  set link [dict get $item link]

  set msg "Orange Truth: $text"
  if {$pub ne ""}  { append msg " | $pub" }
  if {$link ne ""} { append msg " | $link" }
  return $msg
}

proc ::trumptruthrss::announce_items {items} {
  set chans [::trumptruthrss::enabled_channels]
  if {[llength $chans] == 0} { return }
  foreach it $items {
    set msg [::trumptruthrss::format_item $it]
    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 ctype=$ctype)"
    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]} { continue }
    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 {}
  set found 0
  foreach it $items {
    set g [dict get $it guid]
    if {$g eq $last_guid} { set found 1; 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} {
  variable cfg
  if {![::trumptruthrss::chan_enabled $chan]} { return }

  lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  if {$code != 200 || $body eq ""} {
    putserv "PRIVMSG $chan :Orange Truth: couldn't fetch feed (HTTP=$code)."
    return
  }

  set items [::trumptruthrss::parse_feed $body]
  if {[llength $items] == 0} {
    putserv "PRIVMSG $chan :Orange Truth: couldn't parse feed."
    return
  }

  putserv "PRIVMSG $chan :[::trumptruthrss::format_item [lindex $items 0]]"
}

proc ::trumptruthrss::cmd_sync {nick host hand chan text} {
  variable cfg
  variable last_guid
  if {![::trumptruthrss::chan_enabled $chan]} { return }

  lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  if {$code != 200 || $body eq ""} {
    putserv "PRIVMSG $chan :Orange Truth: couldn't sync (HTTP=$code)."
    return
  }

  set items [::trumptruthrss::parse_feed $body]
  if {[llength $items] == 0} {
    putserv "PRIVMSG $chan :Orange Truth: couldn't parse feed."
    return
  }

  # Collect items newer than last_guid
  set new {}
  if {$last_guid ne ""} {
    foreach it $items {
      set g [dict get $it guid]
      if {$g eq $last_guid} break
      lappend new $it
    }
  } else {
    # empty, treat everything in feed as "new"
    set new $items
  }

  if {[llength $new] == 0} {
    putserv "PRIVMSG $chan :Orange Truth: no new posts."
    return
  }

  # Announce oldest to newest, paced
  set new [lreverse $new]
  set delay 0
  foreach it $new {
    set msg [::trumptruthrss::format_item $it]
    utimer $delay [list putserv "PRIVMSG $chan :$msg"]
    incr delay 2
  }

  # Update pointer to newest item in feed
  set last_guid [dict get [lindex $items 0] guid]
  ::trumptruthrss::save_state

  putserv "PRIVMSG $chan :Orange Truth: synced (+[llength $new] announced)."
}

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 "trumptruths.tcl loaded - Enable with: .chanset #chan +enabletruth"