Trumptruths.tcl

TCL Guest 8 Views Size: 10.77 KB Posted on: Jan 16, 26 @ 9:13 PM
  1. # Announces new Trump posts via trumpstruth.org RSS
  2. # Feed: https://www.trumpstruth.org/feed
  3.  
  4. catch {setudef flag enabletruth}
  5. catch {setudef flag enableTruth}
  6.  
  7. namespace eval ::trumptruthrss {
  8.   variable cfg
  9.   array set cfg {
  10.     feed_url         "https://www.trumpstruth.org/feed"
  11.     poll_seconds     3600
  12.     curl             "/usr/bin/curl"
  13.     curl_timeout     15
  14.     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"
  15.     state_file       "trumptruthrss.state"
  16.     max_chars        420
  17.     strip_non_ascii  1
  18.         exclude_retruths  1
  19.     max_new_announce 5
  20.     debug            0
  21.   }
  22.  
  23.   variable last_guid ""
  24.   variable in_progress 0
  25.   variable timer_id ""
  26. }
  27.  
  28. if {[info commands lreverse] eq ""} {
  29.   proc lreverse {lst} {
  30.     set out {}
  31.     foreach x $lst { set out [linsert $out 0 $x] }
  32.     return $out
  33.   }
  34. }
  35.  
  36. proc ::trumptruthrss::dlog {msg} {
  37.   variable cfg
  38.   if {$cfg(debug)} { putlog "trumptruthrss: $msg" }
  39. }
  40.  
  41. proc ::trumptruthrss::chan_enabled {chan} {
  42.   if {![catch {set v [channel get $chan enabletruth]}]} { return $v }
  43.   if {![catch {set v [channel get $chan enableTruth]}]} { return $v }
  44.   putlog "trumptruthrss: channel flag enabletruth/enableTruth not defined"
  45.   return 0
  46. }
  47.  
  48. proc ::trumptruthrss::enabled_channels {} {
  49.   set out {}
  50.   foreach c [channels] {
  51.     if {[::trumptruthrss::chan_enabled $c]} { lappend out $c }
  52.   }
  53.   return $out
  54. }
  55.  
  56. proc ::trumptruthrss::load_state {} {
  57.   variable cfg
  58.   variable last_guid
  59.   if {![file exists $cfg(state_file)]} { set last_guid ""; return }
  60.   catch {
  61.     set f [open $cfg(state_file) r]
  62.     set last_guid [string trim [read $f]]
  63.     close $f
  64.   }
  65. }
  66.  
  67. proc ::trumptruthrss::save_state {} {
  68.   variable cfg
  69.   variable last_guid
  70.   catch {
  71.     set f [open $cfg(state_file) w]
  72.     puts $f $last_guid
  73.     close $f
  74.   }
  75. }
  76.  
  77. proc ::trumptruthrss::is_retruth {item} {
  78.   # look for "ReTruth", "RT @user ..."
  79.  # Sometimes the link points away from @realDonaldTrump
  80.   set raw [string tolower [dict get $item text]]
  81.   if {[string first "retruth" $raw] >= 0} { return 1 }
  82.  
  83.   set clean [string tolower [::trumptruthrss::strip_html [dict get $item text]]]
  84.   if {[string first "rt @" $clean] == 0} { return 1 }
  85.  
  86.   if {[dict exists $item link]} {
  87.     set link [string tolower [dict get $item link]]
  88.     if {$link ne "" && [string first "%40realdonaldtrump" $link] < 0 && [string first "/@realdonaldtrump" $link] < 0} {
  89.       return 1
  90.     }
  91.   }
  92.  
  93.   return 0
  94. }
  95.  
  96. proc ::trumptruthrss::curl_fetch {url} {
  97.   variable cfg
  98.   set cmd [list $cfg(curl) -s -L --compressed -m $cfg(curl_timeout) \
  99.     -H "Accept: application/rss+xml, application/xml;q=0.9, */*;q=0.8" \
  100.     -H "User-Agent: $cfg(user_agent)" \
  101.     -w "\n__CURLMETA__:%{http_code}:%{content_type}\n" \
  102.     $url \
  103.   ]
  104.  
  105.   dlog "Fetching: $url"
  106.  
  107.   if {[catch {set out [eval exec $cmd]} err]} {
  108.     putlog "trumptruthrss: curl failed: $err"
  109.     return [list 0 "" ""]
  110.   }
  111.  
  112.   set code 0
  113.   set ctype ""
  114.   if {[regexp {__CURLMETA__:(\d+):([^\r\n]+)} $out -> code ctype]} {
  115.     regsub {(\r?\n)?__CURLMETA__:[0-9]+:[^\r\n]+(\r?\n)?$} $out "" body
  116.   } else {
  117.     set body $out
  118.   }
  119.  
  120.   dlog "HTTP $code (ctype=$ctype) bytes=[string length $body]"
  121.   return [list $code $ctype $body]
  122. }
  123.  
  124. proc ::trumptruthrss::html_decode {s} {
  125.   set s [string map {
  126.     "&amp;"  "&"
  127.     "&lt;"   "<"
  128.     "&gt;"   ">"
  129.     "&quot;" "\""
  130.     "&#34;"  "\""
  131.     "&#39;"  "'"
  132.     "&apos;" "'"
  133.     "&nbsp;" " "
  134.   } $s]
  135.   return $s
  136. }
  137.  
  138. proc ::trumptruthrss::strip_html {html} {
  139.   set s $html
  140.   regsub -all -nocase {<br\s*/?>} $s "\n" s
  141.   regsub -all -nocase {</p>\s*<p>} $s "\n" s
  142.   regsub -all {<[^>]+>} $s "" s
  143.   set s [::trumptruthrss::html_decode $s]
  144.   regsub -all {[[:space:]]+} $s " " s
  145.   return [string trim $s]
  146. }
  147.  
  148. proc ::trumptruthrss::rss_gettag {block tag} {
  149.   set open "<$tag"
  150.   set close "</$tag>"
  151.  
  152.   set i [string first $open $block]
  153.   if {$i < 0} { return "" }
  154.  
  155.   set gt [string first ">" $block $i]
  156.   if {$gt < 0} { return "" }
  157.  
  158.   set j [string first $close $block $gt]
  159.   if {$j < 0} { return "" }
  160.  
  161.   set val [string range $block [expr {$gt+1}] [expr {$j-1}]]
  162.   set val [string trim $val]
  163.  
  164.         if {[string first {<![CDATA[} $val] == 0} {
  165.           set end [string last {]]>} $val]
  166.           if {$end > 9} {
  167.                 set val [string range $val 9 [expr {$end-1}]]
  168.                 set val [string trim $val]
  169.           }
  170.             }
  171. }
  172.  
  173. proc ::trumptruthrss::parse_feed {xml} {
  174.   set head [string tolower [string range $xml 0 200]]
  175.   if {[string first "<!doctype" $head] >= 0 || [string first "<html" $head] >= 0} {
  176.     putlog "trumptruthrss: Got HTML instead of RSS/XML."
  177.     return {}
  178.   }
  179.  
  180.   if {([string first "<?xml" $head] < 0) && ([string first "<rss" $head] < 0) && ([string first "<feed" $head] < 0)} {
  181.     putlog "trumptruthrss: Response doesn't look like RSS/XML. Head: [string range $xml 0 120]"
  182.     return {}
  183.   }
  184.  
  185.   set items {}
  186.   set pos 0
  187.   while {1} {
  188.     set s [string first "<item" $xml $pos]
  189.     if {$s < 0} break
  190.     set e [string first "</item>" $xml $s]
  191.     if {$e < 0} break
  192.     lappend items [string range $xml $s [expr {$e+6}]]
  193.     set pos [expr {$e+7}]
  194.   }
  195.  
  196.   if {[llength $items] == 0} {
  197.     putlog "trumptruthrss: No <item> elements found."
  198.     return {}
  199.   }
  200.  
  201.   set out {}
  202.   foreach it $items {
  203.     set guid [rss_gettag $it "guid"]
  204.     set link [rss_gettag $it "link"]
  205.     set title [rss_gettag $it "title"]
  206.     set desc  [rss_gettag $it "description"]
  207.     set enc   [rss_gettag $it "content:encoded"]
  208.     set pub   [rss_gettag $it "pubDate"]
  209.  
  210.     set text ""
  211.     if {$enc ne ""} {
  212.       set text $enc
  213.     } elseif {$desc ne ""} {
  214.       set text $desc
  215.     } else {
  216.       set text $title
  217.     }
  218.  
  219.     if {$guid eq ""} {
  220.       if {$link ne ""} { set guid $link } else { set guid $title }
  221.     }
  222.  
  223.     lappend out [dict create guid $guid link $link text $text pubDate $pub]
  224.   }
  225.   return $out
  226. }
  227.  
  228. proc ::trumptruthrss::format_item {item} {
  229.   variable cfg
  230.   set text [::trumptruthrss::strip_html [dict get $item text]]
  231.   regsub -all {[[:space:]]+} $text " " text
  232.   set text [string trim $text]
  233.  
  234.   if {$cfg(strip_non_ascii)} {
  235.     regsub -all {[^\x00-\x7F]} $text "" text
  236.   }
  237.  
  238.   if {[string length $text] > $cfg(max_chars)} {
  239.     set text "[string range $text 0 [expr {$cfg(max_chars)-4}]]..."
  240.   }
  241.  
  242.   set pub [dict get $item pubDate]
  243.   set link [dict get $item link]
  244.  
  245.   set msg "Orange Truth: $text"
  246.   if {$pub ne ""}  { append msg " | $pub" }
  247.   if {$link ne ""} { append msg " | $link" }
  248.   return $msg
  249. }
  250.  
  251. proc ::trumptruthrss::announce_items {items} {
  252.   set chans [::trumptruthrss::enabled_channels]
  253.   if {[llength $chans] == 0} { return }
  254.   foreach it $items {
  255.     set msg [::trumptruthrss::format_item $it]
  256.     foreach c $chans {
  257.       putserv "PRIVMSG $c :$msg"
  258.     }
  259.   }
  260. }
  261.  
  262. proc ::trumptruthrss::schedule {} {
  263.   variable cfg
  264.   variable timer_id
  265.   if {$timer_id ne ""} { catch {killutimer $timer_id} }
  266.   set timer_id [utimer $cfg(poll_seconds) ::trumptruthrss::poll]
  267. }
  268.  
  269. proc ::trumptruthrss::poll {} {
  270.   variable cfg
  271.   variable last_guid
  272.   variable in_progress
  273.  
  274.   ::trumptruthrss::schedule
  275.   if {$in_progress} { return }
  276.   set in_progress 1
  277.  
  278.   if {[llength [::trumptruthrss::enabled_channels]] == 0} {
  279.     set in_progress 0
  280.     return
  281.   }
  282.  
  283.   lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  284.   if {$code != 200 || $body eq ""} {
  285.     putlog "trumptruthrss: fetch failed (HTTP=$code ctype=$ctype)"
  286.     set in_progress 0
  287.     return
  288.   }
  289.  
  290. set items [::trumptruthrss::parse_feed $body]
  291.  
  292. if {[info exists cfg(exclude_retruths)] && $cfg(exclude_retruths)} {
  293.   set filtered {}
  294.   foreach it $items {
  295.     if {[::trumptruthrss::is_retruth $it]} { continue }
  296.     lappend filtered $it
  297.   }
  298.   set items $filtered
  299. }
  300.  
  301. if {[llength $items] == 0} { set in_progress 0; return }
  302.  
  303.   if {$last_guid eq ""} {
  304.     set last_guid [dict get [lindex $items 0] guid]
  305.     ::trumptruthrss::save_state
  306.     set in_progress 0
  307.     return
  308.   }
  309.  
  310.   set new {}
  311.   set found 0
  312.   foreach it $items {
  313.     set g [dict get $it guid]
  314.     if {$g eq $last_guid} { set found 1; break }
  315.     lappend new $it
  316.   }
  317.  
  318.   if {[llength $new] == 0} { set in_progress 0; return }
  319.  
  320.   if {[llength $new] > $cfg(max_new_announce)} {
  321.     set new [lrange $new 0 [expr {$cfg(max_new_announce)-1}]]
  322.   }
  323.  
  324.   ::trumptruthrss::announce_items [lreverse $new]
  325.  
  326.   set last_guid [dict get [lindex $items 0] guid]
  327.   ::trumptruthrss::save_state
  328.   set in_progress 0
  329. }
  330.  
  331. proc ::trumptruthrss::cmd_latest {nick host hand chan text} {
  332.   variable cfg
  333.   if {![::trumptruthrss::chan_enabled $chan]} { return }
  334.  
  335.   lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  336.   if {$code != 200 || $body eq ""} {
  337.     putserv "PRIVMSG $chan :Orange Truth: couldn't fetch feed (HTTP=$code)."
  338.     return
  339.   }
  340.  
  341.   set items [::trumptruthrss::parse_feed $body]
  342.   if {[llength $items] == 0} {
  343.     putserv "PRIVMSG $chan :Orange Truth: couldn't parse feed."
  344.     return
  345.   }
  346.  
  347.   putserv "PRIVMSG $chan :[::trumptruthrss::format_item [lindex $items 0]]"
  348. }
  349.  
  350. proc ::trumptruthrss::cmd_sync {nick host hand chan text} {
  351.   variable cfg
  352.   variable last_guid
  353.   if {![::trumptruthrss::chan_enabled $chan]} { return }
  354.  
  355.   lassign [::trumptruthrss::curl_fetch $cfg(feed_url)] code ctype body
  356.   if {$code != 200 || $body eq ""} {
  357.     putserv "PRIVMSG $chan :Orange Truth: couldn't sync (HTTP=$code)."
  358.     return
  359.   }
  360.  
  361.   set items [::trumptruthrss::parse_feed $body]
  362.   if {[llength $items] == 0} {
  363.     putserv "PRIVMSG $chan :Orange Truth: couldn't parse feed."
  364.     return
  365.   }
  366.  
  367.   # Collect items newer than last_guid
  368.   set new {}
  369.   if {$last_guid ne ""} {
  370.     foreach it $items {
  371.       set g [dict get $it guid]
  372.       if {$g eq $last_guid} break
  373.       lappend new $it
  374.     }
  375.   } else {
  376.     # empty, treat everything in feed as "new"
  377.     set new $items
  378.   }
  379.  
  380.   if {[llength $new] == 0} {
  381.     putserv "PRIVMSG $chan :Orange Truth: no new posts."
  382.     return
  383.   }
  384.  
  385.   # Announce oldest to newest, paced
  386.   set new [lreverse $new]
  387.   set delay 0
  388.   foreach it $new {
  389.     set msg [::trumptruthrss::format_item $it]
  390.     utimer $delay [list putserv "PRIVMSG $chan :$msg"]
  391.     incr delay 2
  392.   }
  393.  
  394.   # Update pointer to newest item in feed
  395.   set last_guid [dict get [lindex $items 0] guid]
  396.   ::trumptruthrss::save_state
  397.  
  398.   putserv "PRIVMSG $chan :Orange Truth: synced (+[llength $new] announced)."
  399. }
  400.  
  401. catch {unbind pub - "!truth"     ::trumptruthrss::cmd_latest}
  402. catch {unbind pub - "!truthsync" ::trumptruthrss::cmd_sync}
  403. bind pub - "!truth"     ::trumptruthrss::cmd_latest
  404. bind pub - "!truthsync" ::trumptruthrss::cmd_sync
  405.  
  406. ::trumptruthrss::load_state
  407. ::trumptruthrss::schedule
  408. putlog "trumptruths.tcl loaded - Enable with: .chanset #chan +enabletruth"

Raw Paste

Comments 0
Login to post a comment.
  • No comments yet. Be the first.
Login to post a comment. Login or Register
We use cookies. To comply with GDPR in the EU and the UK we have to show you these.

We use cookies and similar technologies to keep this website functional (including spam protection via Google reCAPTCHA or Cloudflare Turnstile), and — with your consent — to measure usage and show ads. See Privacy.