uptimekuma.tcl

########## CONFIG ##########

# Port Eggdrop will listen on for Uptime Kuma
set kuma_webhook_port   8799

# Path Uptime Kuma will call: http://host:8799/kuma
set kuma_webhook_path   "/kuma"

# Channel to post notifications into
set kuma_webhook_chan   "#status"

# Optional header-based secret: X-Kuma-Secret
# If empty, no secret check is performed.
set kuma_webhook_secret ""

########## COLORS ##########
set kuma_color_reset "\017"
set kuma_color_red   "\00304"
set kuma_color_green "\00303"

########## INTERNAL STATE ##########
array set kuma_state       {}
array set kuma_method      {}
array set kuma_path        {}
array set kuma_len         {}
array set kuma_body        {}
array set kuma_secret_hdr  {}

########## LISTENER SETUP ##########

if {![info exists kuma_webhook_initialized]} {
    set kuma_webhook_initialized 1
    listen $kuma_webhook_port script kuma:accept
    putlog "Uptime Kuma webhook (JSON): listening on port $kuma_webhook_port, path $kuma_webhook_path"
}

proc kuma:accept {idx} {
    global kuma_state kuma_len kuma_body kuma_secret_hdr
    set kuma_state($idx) "request"
    set kuma_len($idx) 0
    set kuma_body($idx) ""
    set kuma_secret_hdr($idx) ""
    control $idx kuma:control
    return 0
}

########## MAIN CONTROL (request / headers / body) ##########

proc kuma:control {idx text} {
    global kuma_state kuma_method kuma_path kuma_len kuma_body kuma_secret_hdr

    if {[catch {set state $kuma_state($idx)}]} {
        set kuma_state($idx) "request"
        set state "request"
    }

    # Empty line outside body usually means connection closed
    if {$text eq "" && $state ne "body"} {
        kuma:cleanup $idx
        return 0
    }

    switch -- $state {
        request {
            # First line: "POST /kuma HTTP/1.1"
            if {![regexp {^([A-Z]+) ([^ ]+) HTTP/} $text -> method path]} {
                kuma:respond $idx 400 "Bad Request"
                return 0
            }
            set kuma_method($idx) $method
            set kuma_path($idx)   $path
            set kuma_state($idx)  "headers"
        }

        headers {
            # Blank line = end of headers
            if {$text eq ""} {
                set kuma_state($idx) "body"
                if {$kuma_len($idx) == 0} {
                    kuma:handle $idx
                }
                return 0
            }

            if {[regexp -nocase {^Content-Length:\s*([0-9]+)} $text -> len]} {
                set kuma_len($idx) $len
            } elseif {[regexp -nocase {^X-Kuma-Secret:\s*(.+)} $text -> sec]} {
                set kuma_secret_hdr($idx) [string trim $sec]
            }
        }

        body {
            # Append body content line by line
            append kuma_body($idx) $text

            if {$kuma_len($idx) == 0 || [string length $kuma_body($idx)] >= $kuma_len($idx)} {
                kuma:handle $idx
            }
        }
    }

    return 0
}

########## REQUEST HANDLING ##########

proc kuma:handle {idx} {
    global kuma_method kuma_path kuma_body kuma_secret_hdr
    global kuma_webhook_path kuma_webhook_secret kuma_webhook_chan
    global kuma_color_reset kuma_color_red kuma_color_green

    # Must be POST
    if {$kuma_method($idx) ne "POST"} {
        kuma:respond $idx 405 "Method Not Allowed"
        return
    }

    # Strip any query string
    set uri $kuma_path($idx)
    set pathOnly $uri
    if {[regexp {^([^?]+)} $uri -> p]} {
        set pathOnly $p
    }

    if {$pathOnly ne $kuma_webhook_path} {
        kuma:respond $idx 404 "Not Found"
        return
    }

    # Optional secret check
    if {$kuma_webhook_secret ne ""} {
        if {![info exists kuma_secret_hdr($idx)] || $kuma_secret_hdr($idx) ne $kuma_webhook_secret} {
            kuma:respond $idx 403 "Forbidden"
            return
        }
    }

    set body ""
    if {[info exists kuma_body($idx)]} {
        set body [string trim $kuma_body($idx)]
    }

    # putlog "KUMA raw body: $body"

    # Defaults
    set monitor "Unknown Monitor"
    set reason  "No reason provided"
    set status  "UNKNOWN"

    # Monitor name: from monitor.name if possible
    if {[regexp {"monitor"\s*:\s*{[^}]*"name"\s*:\s*"([^"]*)"} $body -> mname]} {
        set monitor $mname
    } elseif {[regexp {"name"\s*:\s*"([^"]*)"} $body -> mname2]} {
        set monitor $mname2
    }

    # Reason: heartbeat.msg if present, else top-level msg
    if {[regexp {"heartbeat"\s*:\s*{[^}]*"msg"\s*:\s*"([^"]*)"} $body -> hmsg]} {
        set reason $hmsg
    } elseif {[regexp {"msg"\s*:\s*"([^"]*)"} $body -> topmsg]} {
        set reason $topmsg
    }

    # Status: from heartbeat.status (0/1) if possible
    if {[regexp {"heartbeat"\s*:\s*{[^}]*"status"\s*:\s*([0-9]+)} $body -> hstatus]} {
        if {$hstatus eq "1"} {
            set status "UP"
        } elseif {$hstatus eq "0"} {
            set status "DOWN"
        }
    } elseif {[regexp {is (up|down)} [string tolower $reason] -> s]} {
        if {$s eq "up"} {
            set status "UP"
        } elseif {$s eq "down"} {
            set status "DOWN"
        }
    }

    # Colorised status
    set status_colored $status
    if {$status eq "UP"} {
        set status_colored "${kuma_color_green}UP${kuma_color_reset}"
    } elseif {$status eq "DOWN"} {
        set status_colored "${kuma_color_red}DOWN${kuma_color_reset}"
    }

    # Line 1: "<Monitor Name> is (colored)UP/DOWN"
    set line1 "$monitor is $status_colored"

    # Line 2: "<Monitor Name> Failed - <reason>" or "Up - <reason>"
    if {$status eq "DOWN"} {
        set line2 "$monitor Failed - $reason"
    } elseif {$status eq "UP"} {
        set line2 "$monitor Up - $reason"
    } else {
        set line2 "$monitor - $reason"
    }

    if {$kuma_webhook_chan ne ""} {
        putserv "PRIVMSG $kuma_webhook_chan :$line1"
        putserv "PRIVMSG $kuma_webhook_chan :$line2"
    }

    kuma:respond $idx 200 "OK"
}

########## RESPONSE & CLEANUP ##########

proc kuma:respond {idx code text} {
    set body $text
    set len  [string length $body]

    # CRLF line endings for strict HTTP parsers
    putdcc $idx "HTTP/1.1 $code $text\r"
    putdcc $idx "Content-Type: text/plain\r"
    putdcc $idx "Content-Length: $len\r"
    putdcc $idx "\r"
    putdcc $idx $body

    kuma:cleanup $idx
}

proc kuma:cleanup {idx} {
    global kuma_state kuma_method kuma_path kuma_len kuma_body kuma_secret_hdr

    catch {unset kuma_state($idx)}
    catch {unset kuma_method($idx)}
    catch {unset kuma_path($idx)}
    catch {unset kuma_len($idx)}
    catch {unset kuma_body($idx)}
    catch {unset kuma_secret_hdr($idx)}

    catch {killdcc $idx}
}