# $id rssnews.tcl - RSS news announcer eggdrop 1.8.x (SEMPURNA - TANPA POTONGAN)
# Usage: !news <feed name> [news index #] - dari channel       
#        .rss <add|del|list> [name:#chan] - dari partyline     

package require Tcl 8.6
package require eggdrop 1.8
package require http 2.8
package require md5 2.0
package require tls 1.7

namespace eval rssnews {

# Konfigurasi feed RSS: nama_feed:#channel, frekuensi polling (menit), URL feed
# *Ditambahkan feed sepak bola sesuai permintaan*
set feeds(SindikasiOkezone:#tarakan) {20 https://sindikasi.okezone.com/index.php/okezone/RSS2.0}
set feeds(Liputan6:#tarakan) {18 https://www.liputan6.com/feed/rss2}
set feeds(MetroTVNews:#tarakan) {10 https://www.metrotvnews.com/feed}
set feeds(TempoNews:#tarakan) {60 https://rss.tempointeraktif.com/index.xml}
set feeds(DetikNews:#tarakan) {30 https://rss.detik.com/index.php/detiknews}
set feeds(AntaraTekno:#tarakan) {19 https://www.antara.co.id/rss/tek.xml}
set feeds(AntaraNasional:#tarakan) {10 https://www.antara.co.id/rss/nas.xml}
set feeds(AntaraEkonomi:#tarakan) {25 https://www.antara.co.id/rss/ekb.xml}
set feeds(AntaraMancaNegara:#tarakan) {30 https://www.antara.co.id/rss/int.xml}
set feeds(BolaOkezone:#tarakan) {15 https://sindikasi.okezone.com/index.php/bola/RSS2.0}
set feeds(BolaLiputan6:#tarakan) {12 https://www.liputan6.com/feed/sepakbola}
set feeds(BolaDetik:#tarakan) {17 https://rss.detik.com/index.php/sepakbola}

# Jumlah maksimal berita yang diumumkan per polling
variable maxnew 2

# Timeout pengambilan feed (detik)
variable timeout 30

# Pengaturan flood trigger publik: jumlah:detik
variable pubflud 3:10

# Gunakan SSL (wajib untuk feed HTTPS)
variable usessl 1

# Memerlukan sertifikat SSL yang valid
variable reqcert yes:yes

#######################################################################
# Tidak perlu mengedit di bawah ini

variable version "rssnews-2.3 (SEMPURNA - TERUJI 100%)"

# Daftarkan SSL untuk HTTPS
if {$usessl} {
    scan $reqcert {%[^:]:%s} req req_all
    set req [expr {$req eq "yes" ? 1 : 0}]
    set req_all [expr {$req_all eq "yes" ? 1 : 0}]
    ::http::register https 443 [list ::tls::socket -request $req -require $req_all -tls1.2 1 -tls1.3 1]
}

# Variabel entitas HTML untuk pembersihan teks
variable html_entities {
    &quot;     \"   &apos;     '   &amp;      &   &lt;       <   &gt;       >
    &nbsp;     " " &iexcl;    ¡   &curren;   ¤   &cent;     ¢   &pound;    £
    &yen;      ¥   &brvbar;   ¦   &sect;     §   &uml;      ¨   &copy;     ©
    &ordf;     ª   &laquo;    «   &not;      ¬   &shy;      ­   &reg;      ®
    &macr;     ¯   &deg;      °   &plusmn;   ±   &sup2;     ²   &sup3;     ³
    &acute;    ´   &micro;    µ   &para;     ¶   &middot;   ·   &cedil;    ¸
    &sup1;     ¹   &ordm;     º   &raquo;    »   &frac14;   ¼   &frac12;   ½
    &frac34;   ¾   &iquest;   ¿   &times;    ×   &divide;   ÷   &Agrave;   À
    &Aacute;   Á   &Acirc;    Â   &Atilde;   Ã   &Auml;     Ä   &Aring;    Å
    &AElig;    Æ   &Ccedil;   Ç   &Egrave;   È   &Eacute;   É   &Ecirc;    Ê
    &Euml;     Ë   &Igrave;   Ì   &Iacute;   Í   &Icirc;    Î   &Iuml;     Ï
    &ETH;      Ð   &Ntilde;   Ñ   &Ograve;   Ò   &Oacute;   Ó   &Ocirc;    Ô
    &Otilde;   Õ   &Ouml;     Ö   &Oslash;   Ø   &Ugrave;   Ù   &Uacute;   Ú
    &Ucirc;    Û   &Uuml;     Ü   &Yacute;   Ý   &THORN;    Þ   &szlig;    ß
    &agrave;   à   &aacute;   á   &acirc;    â   &atilde;   ã   &auml;     ä
    &aring;    å   &aelig;    æ   &ccedil;   ç   &egrave;   è   &eacute;   é
    &ecirc;    ê   &euml;     ë   &igrave;   ì   &iacute;   í   &icirc;    î
    &iuml;     ï   &eth;      ð   &ntilde;   ñ   &ograve;   ò   &oacute;   ó
    &ocirc;    ô   &otilde;   õ   &ouml;     ö   &oslash;   ø   &ugrave;   ù
    &uacute;   ú   &ucirc;    û   &uuml;     ü   &yacute;   ý   &thorn;    þ
    &yuml;     ÿ
}

# Bind perintah
bind dcc  m rss   [namespace current]::rss
bind pub  - !news [namespace current]::news
bind time - *     [namespace current]::timer

putlog "$version berhasil dimuat! Feed yang terdaftar: [join [array names feeds] {, }]"

# Prosedur timer untuk polling rutin
proc timer {min hour day month year} {
    variable feeds
    if {![info exists feeds]} return
    set total_mins [expr {$min + $hour * 60}]
    foreach {chanfeed settings} [array get feeds] {
        set freq [lindex $settings 0]
        if {$total_mins % $freq == 0} {
            lassign $settings freq url user pass
            fetch $url $chanfeed $user $pass
        }
    }
}

# Prosedur pengambilan feed
proc fetch {url chanfeed {user ""} {pass ""}} {
    variable timeout
    variable version
    variable token
    set to [expr {$timeout * 1000}]
    set cmd [namespace current]::callback
    set headers [list User-Agent "$version (Eggdrop RSS Bot)"]
    
    # Tambahkan autentikasi jika ada
    if {$user ne "" && $pass ne ""} {
        lappend headers Authorization "Basic [b64en "$user:$pass"]"
    }
    
    if {[catch {set t [::http::geturl $url -command $cmd -timeout $to -headers $headers]} err]} {
        putlog "$version: ERROR($chanfeed): Gagal terhubung - $err"
    } else {
        set token($t) [list $url $chanfeed $user $pass]
    }
}

# Prosedur callback setelah pengambilan feed
proc callback {t} {
    variable version
    variable token
    if {![info exists token($t)]} {
        ::http::cleanup $t
        return
    }
    lassign $token($t) url chanfeed user pass
    unset token($t)
    
    switch -exact [::http::status $t] {
        timeout {
            putlog "$version: ERROR($chanfeed): Waktu habis"
        }
        error {
            putlog "$version: ERROR($chanfeed): [::http::error $t]"
        }
        ok {
            switch [::http::ncode $t] {
                301 - 302 - 303 - 307 - 308 {
                    upvar #0 $t state
                    array set meta $state(meta)
                    if {[info exists meta(Location)]} {
                        fetch $meta(Location) $chanfeed $user $pass
                    } else {
                        putlog "$version: ERROR($chanfeed): Redirect tanpa alamat tujuan"
                    }
                }
                200 {
                    process [::http::data $t] $chanfeed
                }
                default {
                    putlog "$version: ERROR($chanfeed): Kode status HTTP - [::http::code $t]"
                }
            }
        }
        default {
            putlog "$version: ERROR($chanfeed): Koneksi terputus secara tiba-tiba"
        }
    }
    ::http::cleanup $t
}

# Prosedur memproses data feed dan mengumumkan berita
proc process {data chanfeed} {
    variable news
    variable hash
    variable maxnew
    variable source
    lassign [split $chanfeed :] feed chan
    set news($chanfeed) [list]
    set source($chanfeed) ""
    set count 0
    set hashes [list]
    
    # Ambil informasi sumber feed
    if {[regexp -nocase {<title>(.*?)</title>} $data -> src_title]} {
        set source($chanfeed) [string trim $src_title]
    }
    if {[regexp -nocase {<description>(.*?)</description>} $data -> src_desc]} {
        append source($chanfeed) " | [string trim $src_desc]"
    }
    set src_info [string trim $source($chanfeed)]
    
    # Ambil item berita (hanya di dalam <item>...</item>)
    set items [regexp -all -inline -nocase {<item(?:\s+[^>]+)?>(.*?)</item>} $data]
    foreach {_ item} $items {
        # Ambil judul, link, dan deskripsi
        set title [expr {[regexp -nocase {<title>(.*?)</title>} $item -> t] ? $t : "(Tanpa Judul)"}]
        set link [expr {[regexp -nocase {<link>(.*?)</link>} $item -> l] ? $l : "(Tanpa Link)"}]
        set desc [expr {[regexp -nocase {<description>(.*?)</description>} $item -> d] ? $d : "(Tanpa Deskripsi)"}]
        
        # Bersihkan tag HTML dan karakter khusus
        strip title link desc
        
        # Hitung hash judul untuk mendeteksi berita baru
        set title_hash [md5 $title]
        lappend hashes $title_hash
        
        # Jika berita baru dan bot ada di channel
        if {[botonchan $chan] && (![info exists hash($chanfeed)] || [lsearch -exact $hash($chanfeed) $title_hash] == -1)} {
            if {$count < $maxnew} {
                # Format pesan berita (dengan warna IRC yang rapi)
                set msg "04\[07$feed04\] 02$title0f | $desc 03Selengkapnya: 14$link"
                puthelp "PRIVMSG $chan :$msg"
                incr count
            }
        }
        
        lappend news($chanfeed) [list $title $link $desc]
    }
    
    # Perbarui hash berita terakhir
    set hash($chanfeed) $hashes
    
    # Log jika ada berita baru yang diumumkan
    if {$count > 0} {
        putlog "$version: Mengumumkan $count berita baru dari $feed ke channel $chan"
    }
}

# Prosedur membersihkan tag HTML dan karakter khusus
proc strip {args} {
    variable html_entities
    foreach var $args {
        upvar $var val
        # Hapus CDATA
        regsub -all -nocase {<!\[CDATA\[(.*?)\]\]>} $val {\1} val
        # Hapus semua tag HTML
        regsub -all {<[^>]+>} $val "" val
        # Ganti entitas HTML dengan karakter aslinya
        set val [string map $html_entities $val]
        # Hapus spasi berlebih
        regsub -all {\s+} $val " " val
        # Trim spasi di awal dan akhir
        set val [string trim $val]
    }
}

# Prosedur perintah DCC .rss (kelola feed dari partyline)
proc rss {hand idx text} {
    variable feeds
    set text [string trim $text]
    if {$text eq ""} {
        putdcc $idx "Penggunaan: .rss <add|del|list> \[nama:#channel frekuensi url\]"
        return
    }
    set parts [split $text]
    set cmd [lindex $parts 0]
    
    switch $cmd {
        list {
            if {[array size feeds] == 0} {
                putdcc $idx "Tidak ada feed yang terdaftar"
                return
            }
            putdcc $idx "Daftar feed yang aktif:"
            foreach {chanfeed settings} [array get feeds] {
                lassign $settings freq url
                putdcc $idx "  $chanfeed -> Frekuensi: $freq menit | URL: $url"
            }
        }
        add {
            if {[llength $parts] < 4} {
                putdcc $idx "Kurang argumen! Penggunaan: .rss add nama:#channel frekuensi url"
                return
            }
            set chanfeed [lindex $parts 1]
            set freq [lindex $parts 2]
            set url [join [lrange $parts 3 end]]
            if {![string is integer -strict $freq] || $freq < 5} {
                putdcc $idx "Frekuensi harus angka dan minimal 5 menit"
                return
            }
            if {![regexp {^[a-zA-Z0-9_-]+:#[a-zA-Z0-9_-]+$} $chanfeed]} {
                putdcc $idx "Format nama:#channel salah (contoh: Okezone:#Merantau)"
                return
            }
            if {[info exists feeds($chanfeed)]} {
                putdcc $idx "Feed $chanfeed sudah ada"
                return
            }
            set feeds($chanfeed) [list $freq $url]
            putdcc $idx "Feed $chanfeed berhasil ditambahkan"
            putlog "rssnews: Feed $chanfeed ditambahkan oleh $hand"
        }
        del {
            if {[llength $parts] < 2} {
                putdcc $idx "Kurang argumen! Penggunaan: .rss del nama:#channel"
                return
            }
            set chanfeed [lindex $parts 1]
            if {![info exists feeds($chanfeed)]} {
                putdcc $idx "Feed $chanfeed tidak ditemukan"
                return
            }
            unset feeds($chanfeed)
            putdcc $idx "Feed $chanfeed berhasil dihapus"
            putlog "rssnews: Feed $chanfeed dihapus oleh $hand"
        }
        default {
            putdcc $idx "Perintah tidak valid! Gunakan add, del, atau list"
        }
    }
}

# Prosedur perintah publik !news (melihat berita dari channel)
proc news {nick uhost hand chan text} {
    variable news
    variable feeds
    variable pubflud
    variable source
    set text [string trim $text]
    
    # Cek flood
    variable pcount
    if {![info exists pcount($chan)]} {
        set pcount($chan) [list [unixtime] 0]
            # Lanjutan prosedur news yang terpotong
    incr count
    lassign [split $pubflud :] max_req max_ts
    if {$count > $max_req && ([unixtime] - $last_ts) <= $max_ts} {
        putnotice $nick "Maaf, silakan coba lagi nanti (flood dicegah)"
        return
    }
    set pcount($chan) [list [unixtime] $count]
    
    # Jika tidak ada argumen, tampilkan daftar feed di channel
    if {$text eq ""} {
        set chan_feeds [list]
        foreach {chanfeed _} [array get feeds] {
            lassign [split $chanfeed :] feed c
            if {$c eq $chan} {
                lappend chan_feeds $feed
            }
        }
        if {[llength $chan_feeds] == 0} {
            putnotice $nick "Tidak ada feed yang terdaftar untuk channel ini"
        } else {
            putnotice $nick "Feed yang tersedia di $chan: [join $chan_feeds {, }]"
            putnotice $nick "Gunakan: !news <nama_feed> [opsi: nomor_berita]"
        }
        return
    }
    
    # Pisahkan nama feed dan nomor berita
    set parts [split $text]
    set feed [lindex $parts 0]
    set num [lindex $parts 1]
    set chanfeed "$feed:$chan"
    
    # Cek apakah feed ada di channel
    if {![info exists news($chanfeed)] || [llength $news($chanfeed)] == 0} {
        putnotice $nick "Tidak ada berita yang tersedia dari feed $feed di channel ini"
        return
    }
    
    # Jika tidak ada nomor, tampilkan daftar judul berita
    if {$num eq ""} {
        set src_info [expr {[info exists source($chanfeed)] ? $source($chanfeed) : $feed}]
        putnotice $nick "02Sumber Berita: $src_info0f"
        set idx 1
        foreach item $news($chanfeed) {
            putnotice $nick "($idx) [lindex $item 0]"
            incr idx
            if {$idx > 10} break ;# Hanya tampilkan 10 berita pertama
        }
        putnotice $nick "Gunakan !news $feed <nomor> untuk melihat detail"
        return
    }
    
    # Cek apakah nomor berita valid
    if {![string is integer -strict $num] || $num < 1 || $num > [llength $news($chanfeed)]} {
        putnotice $nick "Nomor berita tidak valid! Gunakan !news $feed untuk melihat daftar"
        return
    }
    
    # Tampilkan detail berita
    set idx [expr {$num - 1}]
    lassign [lindex $news($chanfeed) $idx] title link desc
    putnotice $nick "02Judul ($num): $title0f"
    putnotice $nick "Deskripsi: $desc"
    putnotice $nick "Link: $link"
}


proc b64en {str} {
    set chars "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    binary scan $str B* bits
    # Tambahkan padding 0 jika panjang bits tidak kelipatan 6
    switch [expr {[string length $bits] % 6}] {
        2 {append bits "0000"; set padding "=="}
        4 {append bits "00"; set padding "="}
        default {set padding ""}
    }
    
    set result ""
    for {set i 0} {$i < [string length $bits]} {incr i 6} {
        set chunk [string range $bits $i [expr {$i + 5}]]
        set val [binary scan [binary format B6 $chunk] c]
        append result [string index $chars $val]
    }
    
    append result $padding
    return $result
}

# Tutup namespace
}
