#!/usr/local/bin/tclsh9.0

# NewsGetter - get data from the nntp server in response to redis requests.

proc putd s {puts $s}

lassign $argv service debug
source ${service}_config.tcl
source retcl.tm
source distcl.tcl

package require retcl
retcl create redis

source nntp.tcl; # For local fix
package require nntp

set debug [expr {$debug==1 ? 1 : 0}]

proc nntp_connect {} {
    set ::nntp [::nntp::nntp $::nntp_server]
    $::nntp configure -binary 1 -debug $::debug
    if {[info exists ::nntp_user]} {
        $::nntp authinfo $::nntp_user $::nntp_pass
    }
}
nntp_connect
puts [$nntp mode_reader]

proc nntp_retry script {
    if {[catch {uplevel $script} result]} {
        switch -glob $result {
            {nntp: unexpected EOF *} -
            {error flushing * broken pipe} {
                puts "CAUGHT: '$result', RETRYING: '$script'"
	        catch {$::nntp quit}
	        after 100
	        nntp_connect
	        uplevel $script
            }
            default {error $result}
        }
    } else {
        return $result
    }
}

set week 604800; #seconds
set day 86400  ; #seconds
set hour 3600  ; #seconds
set fivemin 300; #seconds
set thisyear [clock format [clock seconds] -format %Y]

proc execute {func args} {
    lassign $args what num min fld pat; # in most cases $what is the group
    switch $func {
        group {return -secs2keep $::fivemin [groupinfo $what]}
        hdrs {
            lassign [groupinfo $what] est first last

	    if {$num == 0 || $num > $last} {
	        set end $last
	        set keeptime $::fivemin
	    } else {
	        set end $num
	        set keeptime $::day
	    }
	    #puts "first=$first last=$last end=$end keeptime=$keeptime"
            set xover {}
            while {$end >= $first} {
                # Round the start point for better caching of followup requests
                set start [expr {max($first, ((($end-500) / 100) * 100) + 1)}]
                #puts "xover $start $end"
                ledit xover -1 -1 {*}[nntp_retry {$::nntp xover $start $end}]
                if {[llength $xover] > 300} break
	        set end [expr {$start - 1}]
            }
	    #puts "length of xover is [llength $xover]"
	    return -secs2keep $keeptime [get_headers $xover]
        }
        xpat {
            lassign [groupinfo $what] est first last
            if {$min > $first} {set first $min}

	    if {$num == 0 || $num > $last} {
	        set end $last
	        set keeptime $::fivemin
	    } else {
	        set end $num
	        set keeptime $::hour
	    }
	    #putd "first=$first last=$last end=$end keeptime=$keeptime"
            set xpat {}
            set step 10000
            while {$end >= $first} {
                # Round the start point for better caching of followup requests
                set start [expr {max($first, ((($end-$step) / 1000) * 1000) + 1)}]
                #putd "nntp_retry {$::nntp xpat $fld $start-$end $pat}"
                set output [nntp_retry {$::nntp xpat $fld $start-$end $pat}]
		#putd $output
                ledit xpat -1 -1 {*}$output
	        set end [expr {$start - 1}]
                if {[llength $xpat] > 30} break
	        incr step $step ;# double step size
            }
            if {$end < $first} {set end -1}
	    #puts "length of xover is [llength $xover]"
	    return -secs2keep $keeptime [list $end $xpat]
        }
        art {
            groupinfo $what
            set val [nntp_retry {$::nntp article $num}]
            return -secs2keep $::week $val
        }
        mid {
            # $what is the message-id here
            set val [nntp_retry {$::nntp article $what}]
            return -secs2keep $::week $val
        }
        post {
            # $what is the article text here
            return [nntp_retry {$::nntp post $what}]
        }
        default {
            error "UNRECOGNISED REQUEST: '$func'"
        }
    }
}

proc groupinfo grp {
    set groupinfo [nntp_retry {$::nntp group $grp}]
    return $groupinfo
}

proc get_headers {xover} {

    set posts [dict create]
    set headers {}

    foreach hdr $xover {
        lassign [split $hdr \t] num sub aut tim id refs sz1 sz2 xref

        dict set posts $id $num

        # Find post this one is followup to -
        # a single article number instead of the list of referenced msgids
        set prev 0
        foreach ref [lreverse $refs] {
            if {[dict exists $posts $ref]} {
                set prev [dict get $posts $ref]
                break
	    }
        }
        if {[regexp {(\d\d? [[:alpha:]]{3}) (\d{4})} $tim - date year]} {
            if {$year == $::thisyear} {
                set tim $date
            } else {
                set tim "$date $year"
            }
        }
	lappend headers $num [list $prev $sub $aut $tim $id]
    }
    return $headers
}

distcl::serve redis $service execute

