# url-shortener.tcl
#
# Eggdrop-script som upptäcker långa URL:er i kanalen, kortar dem via
# https://url.thern.io och skriver ut sidans <title> i kanalen.
#
# Ladda från eggdrop.conf:
#   source scripts/url-shortener.tcl

package require http
package require tls

namespace eval urlshort {
    variable minlen     40
    variable shortener  "https://url.thern.io/api/shorten"
    variable useragent  "Mozilla/5.0 (compatible; eggdrop-urlshort/1.0)"
    variable timeout    8000
    variable maxbytes   524288
    variable maxredir   3
    variable ignorechan {}
}

::http::register https 443 [list ::tls::socket -autoservername true]

bind pubm - "*" urlshort::scan

proc urlshort::scan {nick uhost hand chan text} {
    variable minlen
    variable ignorechan
    if {[lsearch -exact -nocase $ignorechan $chan] >= 0} { return }
    foreach word [split $text] {
        if {[regexp -nocase {^(https?://[^\s<>"]+)$} $word -> url]} {
            set url [string trimright $url ".,;:!?)]}"]
            if {[string length $url] >= $minlen} {
                if {[catch {handle $chan $url} err]} {
                    putlog "urlshort error: $err"
                }
            }
        }
    }
}

proc urlshort::handle {chan url} {
    set title [fetch_title $url]
    set short [shorten $url]
    set parts [list]
    if {$short ne ""} { lappend parts "\002Short:\002 $short" }
    if {$title ne ""} { lappend parts "\002Title:\002 $title" }
    if {[llength $parts]} {
        putserv "PRIVMSG $chan :[join $parts { | }]"
    }
}

proc urlshort::fetch_title {url} {
    variable useragent
    variable timeout
    variable maxbytes
    variable maxredir

    set current $url
    for {set i 0} {$i <= $maxredir} {incr i} {
        if {[catch {
            ::http::geturl $current \
                -timeout $timeout \
                -headers [list User-Agent $useragent Accept "text/html,*/*;q=0.5"] \
                -binary 1
        } tok]} {
            return ""
        }

        set status [::http::status $tok]
        set ncode  [::http::ncode  $tok]
        set meta   [::http::meta   $tok]
        set data   [::http::data   $tok]
        ::http::cleanup $tok

        if {$status ne "ok"} { return "" }

        if {$ncode >= 300 && $ncode < 400} {
            set loc ""
            foreach {k v} $meta {
                if {[string equal -nocase $k "location"]} { set loc $v; break }
            }
            if {$loc eq ""} { return "" }
            if {![regexp -nocase {^https?://} $loc]} {
                regexp {^(https?://[^/]+)} $current -> base
                if {[string index $loc 0] eq "/"} {
                    set loc "${base}${loc}"
                } else {
                    set loc "${base}/${loc}"
                }
            }
            set current $loc
            continue
        }

        if {[string length $data] > $maxbytes} {
            set data [string range $data 0 $maxbytes]
        }

        set charset "utf-8"
        foreach {k v} $meta {
            if {[string equal -nocase $k "content-type"]} {
                regexp -nocase {charset=([^\s;]+)} $v -> charset
                break
            }
        }
        if {[catch {set data [encoding convertfrom $charset $data]}]} {
            catch {set data [encoding convertfrom utf-8 $data]}
        }

        if {[regexp -nocase {<title[^>]*>(.*?)</title>} $data -> title]} {
            regsub -all {\s+} $title " " title
            set title [string trim $title]
            set title [decode_entities $title]
            if {[string length $title] > 250} {
                set title "[string range $title 0 246]..."
            }
            return $title
        }
        return ""
    }
    return ""
}

proc urlshort::decode_entities {s} {
    set s [string map {
        &amp;   &
        &lt;    <
        &gt;    >
        &quot;  \"
        &apos;  '
        &#39;   '
        &nbsp;  " "
    } $s]
    while {[regexp {&#([0-9]+);} $s -> num]} {
        set ch [format %c $num]
        regsub -all "&#${num};" $s $ch s
    }
    while {[regexp {&#x([0-9a-fA-F]+);} $s -> hex]} {
        set ch [format %c [scan $hex %x]]
        regsub -all -nocase "&#x${hex};" $s $ch s
    }
    return $s
}

proc urlshort::shorten {url} {
    variable shortener
    variable timeout
    variable useragent

    set query [::http::formatQuery url $url]
    if {[catch {
        ::http::geturl $shortener \
            -query $query \
            -timeout $timeout \
            -headers [list User-Agent $useragent Accept "application/json,text/plain"]
    } tok]} {
        return ""
    }

    set status [::http::status $tok]
    set data   [string trim [::http::data $tok]]
    ::http::cleanup $tok

    if {$status ne "ok" || $data eq ""} { return "" }

    if {[regexp -nocase {"(?:short_url|shortUrl|short|url|result)"\s*:\s*"([^"]+)"} $data -> short]} {
        return $short
    }
    if {[regexp {^https?://\S+$} $data]} {
        return $data
    }
    if {[regexp {(https?://\S+)} $data -> short]} {
        return [string trimright $short {",}]
    }
    return ""
}

putlog "url-shortener.tcl loaded"