#!/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